packages feed

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 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