json-tools (empty) → 0.1.0
raw patch · 12 files changed
+305/−0 lines, 12 filesdep +AttoJsondep +basedep +bytestringsetup-changed
Dependencies added: AttoJson, base, bytestring, containers, convertible-text, data-object, data-object-json, process, tar
Files
- LICENSE +30/−0
- Setup.hs +3/−0
- json-concat.hs +11/−0
- json-deep-select-key.hs +22/−0
- json-iter.hs +43/−0
- json-lines.hs +15/−0
- json-strings.hs +23/−0
- json-tools.cabal +62/−0
- json-unlines.hs +15/−0
- json-wrap.hs +18/−0
- json-xargs.hs +28/−0
- tar2json.hs +35/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011, Nicolas Pouillard+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ json-concat.hs view
@@ -0,0 +1,11 @@+import Text.JSON.AttoJSON+import qualified Data.ByteString as S++main :: IO ()+main = S.putStr . showJSON . jsonConcat . either err id . parseJSON =<< S.getContents+ where jsonConcat (JSArray a) = JSArray (concatMap unJSArray a)+ jsonConcat (JSObject _) = error "unexpected non-JSON array"+ jsonConcat _ = error "impossible by decodeStrict post-condition"+ unJSArray (JSArray a) = a+ unJSArray _ = error "unexpected non-JSON array"+ err s = error $ "JSON decoding: " ++ s
+ json-deep-select-key.hs view
@@ -0,0 +1,22 @@+import qualified Data.Map as M+import Text.JSON.AttoJSON+import System.Environment (getArgs)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8++deepSelectKey :: S.ByteString -> JSValue -> [JSValue]+deepSelectKey key (JSArray vs)+ = concatMap (deepSelectKey key) vs+deepSelectKey key (JSObject o)+ = maybe (concatMap (deepSelectKey key) (map snd (M.toList o))) return . M.lookup key $ o+deepSelectKey _ _ = []++main :: IO ()+main = do+ args <- getArgs+ obj <- either fail return . parseJSON =<< S.getContents+ case args of+ [key] ->+ S.putStrLn . showJSON . JSArray $ deepSelectKey (S8.pack key) obj+ _ -> error "usage: json-deep-select-key <key>"+
+ json-iter.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables #-}+import Control.Applicative+import Control.Exception+import System.Environment (getArgs)+import System.Exit (ExitCode)+import System.IO (hClose)+import System.IO.Unsafe (unsafeInterleaveIO)+import qualified System.Process as P+import Text.JSON.AttoJSON+import qualified Data.ByteString as S++err :: String -> a+err s = error $ "JSON decoding: " ++ s++decodeFile :: FilePath -> IO (Either String JSValue)+decodeFile fp = parseJSON <$> S.readFile fp++parseJSONFiles :: [FilePath] -> IO [JSValue]+parseJSONFiles [] = (:[]) . either err id . parseJSON <$> S.getContents+parseJSONFiles xs = mapM (unsafeInterleaveIO . fmap (either err id) . decodeFile) xs++systemWithStdin :: String -> S.ByteString -> IO ExitCode+systemWithStdin shellCmd input = do+ (Just stdinHdl, _, _, pHdl) <-+ P.createProcess (P.shell shellCmd){ P.std_in = P.CreatePipe }+ handle (\(_ :: IOException) -> return ()) $ do+ S.hPutStr stdinHdl input+ hClose stdinHdl+ P.waitForProcess pHdl++unSequence :: JSValue -> [JSValue]+unSequence (JSArray a) = a+unSequence _ = error "unSequence: a JSON sequence was expected"++iterJSON :: String -> [String] -> IO ()+iterJSON cmd jsonfiles =+ mapM_ (mapM_ (systemWithStdin cmd . showJSON) . unSequence)+ =<< parseJSONFiles jsonfiles++main :: IO ()+main = do+ cmd:args <- getArgs+ iterJSON cmd args
+ json-lines.hs view
@@ -0,0 +1,15 @@+import Text.JSON.AttoJSON+import qualified Data.ByteString.Char8 as S++jsonUnlines :: JSValue -> [JSValue]+jsonUnlines (JSArray xs) = xs+jsonUnlines _ = error "Unexpected JSON value, only an array was expected"++main :: IO ()+main = S.putStr -- printing the output+ . S.unlines -- joining lines+ . map showJSON -- showing each item+ . jsonUnlines -- main processing+ . either err id -- error handling+ . parseJSON =<< S.getContents -- reading the input+ where err msg = error $ "JSON parsing: "++msg
+ json-strings.hs view
@@ -0,0 +1,23 @@+import Text.JSON.AttoJSON+import qualified Data.ByteString as S+import Data.Monoid+import Data.Foldable++-- NOTE that the map keys are not included++jsonStrings :: JSValue -> [S.ByteString]+jsonStrings x0 = appEndo (go x0) []+ where go (JSString s) = Endo (s:)+ go (JSNumber _) = mempty+ go (JSBool _) = mempty+ go JSNull = mempty+ go (JSObject m) = foldMap go m+ go (JSArray xs) = foldMap go xs++main :: IO ()+main = S.putStr . showJSON -- printing the output+ . JSArray . map JSString -- building the result+ . jsonStrings -- main processing+ . either err id -- error handling+ . parseJSON =<< S.getContents -- reading the input+ where err = error . ("JSON parsing: "++)
+ json-tools.cabal view
@@ -0,0 +1,62 @@+Name: json-tools+Cabal-Version: >=1.6+Version: 0.1.0+License: BSD3+License-File: LICENSE+Copyright: (c) Nicolas Pouillard+Author: Nicolas Pouillard+Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+Category: JSON, Text, Utils, Tools+Synopsis: A collection of JSON tools+Description: A collection of JSON tools+Stability: Experimental+Build-Type: Simple++executable json-concat+ main-is: json-concat.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring+ ghc-options: -Wall -Odph++executable json-deep-select-key+ main-is: json-deep-select-key.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring, containers+ ghc-options: -Wall -Odph++executable json-iter+ main-is: json-iter.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring, process+ ghc-options: -Wall -Odph++executable json-lines+ main-is: json-lines.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring+ ghc-options: -Wall -Odph++executable json-strings+ main-is: json-strings.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring+ ghc-options: -Wall -Odph++executable json-unlines+ main-is: json-unlines.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring+ ghc-options: -Wall -Odph++executable json-wrap+ main-is: json-wrap.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring+ ghc-options: -Wall -Odph++executable json-xargs+ main-is: json-xargs.hs+ Build-depends: base>=3&&<5, AttoJson, bytestring+ ghc-options: -Wall -Odph++executable tar2json+ main-is: tar2json.hs+ Build-depends: base>=3&&<5, bytestring, convertible-text, data-object, data-object-json, tar+ ghc-options: -Wall -Odph++source-repository head+ type: git+ location: git://github.com/np/json-tools.git
+ json-unlines.hs view
@@ -0,0 +1,15 @@+import Text.JSON.AttoJSON+import qualified Data.ByteString.Char8 as S+import Control.Arrow (second)++main :: IO ()+main = S.putStr . showJSON -- printing the output+ . JSArray -- building the result+ . map err -- error handling+ . map (second parseJSON) -- parsing a line+ . zip [1::Integer ..] -- number lines+ . S.lines -- cut into a list of lines+ =<< S.getContents -- reading the input+ where+ err (ln, Left msg) = error $ "JSON parsing: (line "++show ln++"): "++msg+ err (_, Right x) = x
+ json-wrap.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.List (intersperse)+import Data.Map (toList)+import Data.Monoid+import Text.JSON.AttoJSON+import qualified Data.ByteString as S++-- wrap, as in line-wrapping++main :: IO ()+main = mapM_ S.putStr . ($[]) . f . either err id . parseJSON =<< S.getContents+ where f (JSArray a) = t"[" . cat (intersperse (t"\n,") (map (t . showJSON) a)) . t"]"+ f (JSObject o) = t"{" . cat (intersperse (t"\n,") (map g . toList $ o)) . t"}"+ f _ = error "impossible by decodeStrict post-condition"+ g (key, val) = t key . t ":" . (t . showJSON) val+ err s = error $ "JSON decoding: " ++ s+ t x = (x:)+ cat = appEndo . mconcat . map Endo
+ json-xargs.hs view
@@ -0,0 +1,28 @@+import Text.JSON.AttoJSON+import qualified Data.ByteString.Char8 as S+import Data.Monoid+import Data.Foldable+import Data.Functor+import System.Environment+import System.Exit+import System.Cmd (rawSystem)++-- NOTE that the map keys are not included++jsonArgs :: JSValue -> [String]+jsonArgs x0 = appEndo (go x0) []+ where go (JSString s) = f (S.unpack s)+ go (JSNumber n) = f (show n)+ go (JSBool b) = f (if b then "true" else "false")+ go JSNull = f "null"+ go (JSObject m) = foldMap go m+ go (JSArray xs) = foldMap go xs+ f x = Endo (x:)++main :: IO ()+main = do cmd:argv <- getArgs+ args <- jsonArgs -- main processing+ . either err id -- error handling+ . parseJSON <$> S.getContents -- reading the input+ exitWith =<< rawSystem cmd (argv ++ args)+ where err = error . ("JSON parsing: "++)
+ tar2json.hs view
@@ -0,0 +1,35 @@+import Codec.Archive.Tar as Tar+import Data.Convertible.Base (convertSuccess)+import Data.Object+import Data.Object.Json as Json+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import System.IO++tar2json :: Tar.Entries -> JsonObject+tar2json es0 = Mapping [(k,v) | (k,Just v) <- entries es0] where++ entries :: Tar.Entries -> [(S.ByteString, Maybe JsonObject)]+ entries Done = []+ entries (Fail s) = error s+ entries (Next e es) = (path e, contents e) : entries es++ path :: Tar.Entry -> S.ByteString+ path = S8.pack {- Is this an encoding mistake? -} . entryPath++ contents :: Tar.Entry -> Maybe JsonObject+ contents = fmap (Scalar . JsonString) . f . entryContent where+ f (NormalFile s _) = Just (convertSuccess s)+ f _ = Nothing++main :: IO ()+main+ = do hPutStrLn stderr "Reading standard input..."+ hSetEncoding stdin latin1+ hSetEncoding stdout latin1+ S.putStr -- printing output+ . Json.encode -- producing JSON+ . tar2json -- main translation+ . Tar.read -- reading the archive+ =<< L.getContents -- reading the input