packages feed

json-tools 0.3.1 → 0.4.0

raw patch · 13 files changed

+203/−176 lines, 13 filesdep +aesondep +textdep +unordered-containersdep −AttoJsondep −convertible-textdep −data-objectdep ~tarnew-component:exe:json-quote

Dependencies added: aeson, text, unordered-containers, vector

Dependencies removed: AttoJson, convertible-text, data-object, data-object-json

Dependency ranges changed: tar

Files

Utils.hs view
@@ -1,48 +1,41 @@ {-# LANGUAGE ScopedTypeVariables #-} module Utils-  ( readFilesL, readFilesS, decodeFile, parseJSONFiles+  ( readFiles, decodeFile, parseJSONFiles   , systemWithStdin) where -import Text.JSON.AttoJSON+import Data.Aeson+import Data.Maybe import Data.Functor import Control.Exception-import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import System.IO (hClose) import System.Exit (ExitCode) import System.IO.Unsafe (unsafeInterleaveIO) import qualified System.Process as P -readFilesL :: [String] -> IO [L.ByteString]-readFilesL args+readFiles :: [String] -> IO [L.ByteString]+readFiles args   | null args = fmap (:[]) L.getContents   | otherwise = mapM file args   where file "-" = L.getContents         file xs  = L.readFile xs -readFilesS :: [String] -> IO [S.ByteString]-readFilesS args-  | null args = fmap (:[]) S.getContents-  | otherwise = mapM file args-  where file "-" = S.getContents-        file xs  = S.readFile xs--decodeFile :: FilePath -> IO (Either String JSValue)-decodeFile fp = parseJSON <$> S.readFile fp+decodeFile :: FilePath -> IO (Maybe Value)+decodeFile fp = decode' <$> L.readFile fp -decErr :: String -> a-decErr s = error $ "JSON decoding: " ++ s+decErr :: a+decErr = error "JSON decoding" -parseJSONFiles :: [FilePath] -> IO [JSValue]-parseJSONFiles [] = (:[]) . either decErr id . parseJSON <$> S.getContents-parseJSONFiles xs = mapM (unsafeInterleaveIO . fmap (either decErr id) . decodeFile) xs+parseJSONFiles :: [FilePath] -> IO [Value]+parseJSONFiles [] = (:[]) . fromMaybe decErr . decode' <$> L.getContents+parseJSONFiles xs = mapM (unsafeInterleaveIO . fmap (fromMaybe decErr) . decodeFile) xs -systemWithStdin :: String -> S.ByteString -> IO ExitCode+systemWithStdin :: String -> L.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+    L.hPutStr stdinHdl input     hClose stdinHdl   P.waitForProcess pHdl
json-concat.hs view
@@ -1,5 +1,7 @@-import Text.JSON.AttoJSON-import qualified Data.ByteString as S+import Data.Aeson+import qualified Data.Vector as V+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8 import Control.Monad (when) import System.IO (hPutStrLn, stderr) import System.Exit (exitFailure)@@ -16,11 +18,11 @@ main :: IO () main = do args <- getArgs           when (not . null $ args) usage-          S.putStrLn . 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 "not a JSON document (neither array, nor object)"-        unJSArray (JSArray a)   = a-        unJSArray _             = error "unexpected non-JSON array"-        err s                   = error $ "JSON decoding: " ++ s+          L8.putStrLn . encode . jsonConcat . maybe err id . decode'+            =<< L.getContents+  where jsonConcat (Array a)  = Array (V.concatMap unArray a)+        jsonConcat (Object _) = error "unexpected non-JSON array"+        jsonConcat _          = error "not a JSON document (neither array, nor object)"+        unArray (Array a)     = a+        unArray _             = error "unexpected non-JSON array"+        err                   = error "JSON decoding error"
json-deep-select-key.hs view
@@ -1,22 +1,25 @@-import qualified Data.Map as M-import Text.JSON.AttoJSON+import qualified Data.HashMap.Strict as HM+import Data.Aeson+import qualified Data.Text as T import System.Environment (getArgs)-import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8+import qualified Data.Vector as V+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8 -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 _ _ = []+deepSelectKey :: T.Text -> Value -> V.Vector Value+deepSelectKey key (Array vs)+  = V.concatMap (deepSelectKey key) vs+deepSelectKey key (Object o)+  = maybe (V.concatMap (deepSelectKey key) (V.fromList $ HM.elems o)) return+  . HM.lookup key $ o+deepSelectKey _ _ = V.empty  main :: IO () main = do   args <- getArgs-  obj <- either fail return . parseJSON =<< S.getContents+  obj <- maybe (fail "JSON decoding") return . decode' =<< L.getContents   case args of     [key] ->-      S.putStrLn . showJSON . JSArray $ deepSelectKey (S8.pack key) obj+      L8.putStrLn . encode . Array $ deepSelectKey (T.pack key) obj     _ -> error "Usage: json-deep-select-key <key>"
json-iter.hs view
@@ -2,16 +2,17 @@ import System.IO (hPutStrLn, stderr) import System.Exit (exitFailure) import Control.Monad (when)-import Text.JSON.AttoJSON+import Data.Aeson import Utils (parseJSONFiles, systemWithStdin)+import qualified Data.Vector as V -unSequence :: JSValue -> [JSValue]-unSequence (JSArray a) = a-unSequence _           = error "unSequence: a JSON sequence was expected"+unSequence :: Value -> [Value]+unSequence (Array a) = V.toList a+unSequence _         = error "unSequence: a JSON sequence was expected"  iterJSON :: String -> [String] -> IO () iterJSON cmd jsonfiles =-  mapM_ (mapM_ (systemWithStdin cmd . showJSON) . unSequence)+  mapM_ (mapM_ (systemWithStdin cmd . encode) . unSequence)     =<< parseJSONFiles jsonfiles  usage :: IO a
json-lines.hs view
@@ -1,14 +1,16 @@-import Text.JSON.AttoJSON-import qualified Data.ByteString.Char8 as S+import Data.Aeson+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8 import Control.Monad (when) import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO (hPutStrLn,stderr)-import Utils (readFilesS)+import Utils (readFiles)+import qualified Data.Vector as V -jsonUnlines :: JSValue -> [JSValue]-jsonUnlines (JSArray xs) = xs-jsonUnlines _            = error "Unexpected JSON value, only an array was expected"+jsonUnlines :: Value -> [Value]+jsonUnlines (Array xs) = V.toList xs+jsonUnlines _          = error "Unexpected JSON value, only an array was expected"  usage :: IO a usage = mapM_ (hPutStrLn stderr)@@ -23,13 +25,13 @@ main =  do args <- getArgs     when ("--help"`elem`args) usage-    S.putStr                  -- printing the output-     . S.unlines              -- joining lines-     . map showJSON           -- showing each item+    L.putStr                  -- printing the output+     . L8.unlines             -- joining lines+     . map encode             -- showing each item      . concat                 -- merge lines from all files      . map (                  -- for each file          jsonUnlines          -- main processing-         . either err id      -- error handling-         . parseJSON          -- parsing each file as JSON-       ) =<< readFilesS args  -- reading the input-  where err msg = error $ "JSON parsing: "++msg+         . maybe err id       -- error handling+         . decode'            -- parsing each file as JSON+       ) =<< readFiles args   -- reading the input+  where err = error "JSON decoding error"
+ json-quote.hs view
@@ -0,0 +1,6 @@+import Data.Aeson+import Data.ByteString.Lazy.Char8 as L8+import System.Environment++main :: IO ()+main = L8.putStrLn . encode =<< getArgs
json-select.hs view
@@ -1,52 +1,54 @@ import Data.List import Data.Monoid-import qualified Data.Map as M+import qualified Data.HashMap.Strict as HM import Control.Arrow-import Text.JSON.AttoJSON+import Data.Aeson import System.Environment (getArgs) import System.IO (stderr, hPutStrLn) import System.Exit-import qualified Data.ByteString as S--type JSObject a = M.Map S.ByteString a+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import Data.Text (Text)+import qualified Data.Vector as V -data JSFrame = JSArrayFrm [JSValue] [JSValue]-             | JSObjectFrm S.ByteString (JSObject JSValue)+data Frame = ArrayFrm Array Array+           | ObjectFrm Text Object   deriving (Show) -type JSContext = [JSFrame]+type Context = [Frame] -data JSSegment = JSArrayIndex Int-               | JSObjectKey  S.ByteString-type JSPath = [JSSegment]+data Segment = ArrayIndex Int+             | ObjectKey  Text+type Path = [Segment] -type JSMultiPath = [Maybe JSSegment] -- Nothing means '*'+type MultiPath = [Maybe Segment] -- Nothing means '*' -type JSCxtValue = (JSContext, JSValue)+type CxtValue = (Context, Value) -segmentFromFrame :: JSFrame -> JSSegment-segmentFromFrame (JSArrayFrm prefix _) = JSArrayIndex (length prefix)-segmentFromFrame (JSObjectFrm f _)     = JSObjectKey f+segmentFromFrame :: Frame -> Segment+segmentFromFrame (ArrayFrm prefix _) = ArrayIndex (V.length prefix)+segmentFromFrame (ObjectFrm f _)     = ObjectKey f -pathFromContext :: JSContext -> JSPath+pathFromContext :: Context -> Path pathFromContext = map segmentFromFrame -selectJSONSegment :: JSSegment -> JSValue -> Either String (JSFrame, JSValue)-selectJSONSegment (JSArrayIndex ix) (JSArray vs)-  = case splitAt ix vs of-      (prefix, v : suffix) -> Right (JSArrayFrm prefix suffix, v)-      (_, [])              -> Left msg+selectJSONSegment :: Segment -> Value -> Either String (Frame, Value)+selectJSONSegment (ArrayIndex ix) (Array vs)+  = case V.splitAt ix vs of+      (prefix, suffix)+        | V.null suffix -> Left msg+        | otherwise     -> Right (ArrayFrm prefix (V.tail suffix), V.head suffix)   where msg = "An array with an index "++show ix++" was expected"-selectJSONSegment (JSObjectKey   f) (JSObject o)-  = maybe (Left msg) ok . M.lookup f $ o+selectJSONSegment (ObjectKey f) (Object o)+  = maybe (Left msg) ok . HM.lookup f $ o   where msg   = "An object with a field "++show f++" was expected"-        ok x  = Right (JSObjectFrm f (M.delete f o), x)-selectJSONSegment (JSArrayIndex  _) _+        ok x  = Right (ObjectFrm f (HM.delete f o), x)+selectJSONSegment (ArrayIndex  _) _   = Left "An array was expected"-selectJSONSegment (JSObjectKey   _) _+selectJSONSegment (ObjectKey   _) _   = Left "An object was expected" -selectJSON :: JSCxtValue -> JSPath -> (JSContext, Either String JSValue)+selectJSON :: CxtValue -> Path -> (Context, Either String Value) selectJSON (cxt,val) [] = (cxt, Right val) selectJSON (cxt,val) (seg:path) =   either ((,)cxt . Left) (flip selectJSON path . first (:cxt)) (selectJSONSegment seg val)@@ -57,33 +59,34 @@   where go sx x []                = [f (reverse sx) x []]         go sx x xs@(xs'x : xs'xs) = f (reverse sx) x xs : go (x : sx) xs'x xs'xs -allSubValues :: JSCxtValue -> [JSCxtValue]-allSubValues (_,   JSArray []) = []-allSubValues (cxt, JSArray vs) = zips f vs-  where f prefix value suffix = (JSArrayFrm prefix suffix : cxt, value)-allSubValues (cxt, JSObject o) = map (first f) . M.toList $ o-  where f key = JSObjectFrm key (M.delete key o) : cxt+allSubValues :: CxtValue -> [CxtValue]+allSubValues (cxt, Array vs)+    | V.null vs = []+    | otherwise = zips f (V.toList vs)+  where f prefix value suffix = (ArrayFrm (V.fromList prefix) (V.fromList suffix) : cxt, value)+allSubValues (cxt, Object o) = map (first f) . HM.toList $ o+  where f key = ObjectFrm key (HM.delete key o) : cxt allSubValues _ = [] -selectJSONMaybeSegment :: Maybe JSSegment -> JSCxtValue -> [JSCxtValue]+selectJSONMaybeSegment :: Maybe Segment -> CxtValue -> [CxtValue] selectJSONMaybeSegment (Just seg) (cxt,val) = either (const []) (return . first (:cxt)) $ selectJSONSegment seg val selectJSONMaybeSegment Nothing    cxtval = allSubValues cxtval -selectMultiJSON :: JSCxtValue -> JSMultiPath -> [JSCxtValue]+selectMultiJSON :: CxtValue -> MultiPath -> [CxtValue] selectMultiJSON cxtval []        = return cxtval selectMultiJSON cxtval (mp : ps) = selectJSONMaybeSegment mp cxtval >>= flip selectMultiJSON ps  type Reader a = String -> (a, String) -readJSSegment :: Reader JSSegment+readJSSegment :: Reader Segment readJSSegment xs@('"':_) = case reads xs of -- TODO maybe we should use the JSON syntax for literal strings-                             [r] -> first JSObjectKey r+                             [r] -> first ObjectKey r                              _   -> error "Parse error: malformed string (when reading path segment)" readJSSegment xs         = case reads xs of-                             [r] -> first JSArrayIndex r+                             [r] -> first ArrayIndex r                              _   -> error "Parse error: malformed integer (when reading path segment)" -readJSMultiSegment :: Reader (Maybe JSSegment)+readJSMultiSegment :: Reader (Maybe Segment) readJSMultiSegment ('*':xs) = (Nothing, xs) readJSMultiSegment xs       = first Just . readJSSegment $ xs @@ -93,18 +96,18 @@ readJSPathGen r ('/':xs) = let (seg, ys) = r xs in seg : readJSPathGen r ys readJSPathGen _ (x:_)    = error $ "Parse error: unexpected char "++show x++", '/' was expected" -readJSPath :: String -> JSPath+readJSPath :: String -> Path readJSPath = readJSPathGen readJSSegment -readJSMultiPath :: String -> JSMultiPath+readJSMultiPath :: String -> MultiPath readJSMultiPath = readJSPathGen readJSMultiSegment -showJSPath :: JSPath -> ShowS+showJSPath :: Path -> ShowS showJSPath = (('/':) .) . mconcat . intersperse ('/':) . map showJSSegment -showJSSegment :: JSSegment -> ShowS-showJSSegment (JSObjectKey f)   = shows f-showJSSegment (JSArrayIndex ix) = shows ix+showJSSegment :: Segment -> ShowS+showJSSegment (ObjectKey f)   = shows f+showJSSegment (ArrayIndex ix) = shows ix  -- should already exists distrEitherPair :: (a, Either b c) -> Either (a, b) (a, c)@@ -127,15 +130,15 @@ main :: IO () main = do   args <- getArgs-  let pobj = either fail return . parseJSON =<< S.getContents+  let pobj = maybe (fail "JSON decoding") return . decode' =<< L.getContents   case args of     [] -> usage "Too few arguments"     ["-m", path] ->       do obj <- pobj-         S.putStrLn . showJSON . JSArray . map snd . selectMultiJSON ([], obj) . readJSMultiPath $ path+         L8.putStrLn . encode . Array . V.fromList . map snd . selectMultiJSON ([], obj) . readJSMultiPath $ path     [path] ->       do obj <- pobj-         either err (S.putStrLn . showJSON . snd) . distrEitherPair $ selectJSON ([], obj) (readJSPath path)+         either err (L8.putStrLn . encode . snd) . distrEitherPair $ selectJSON ([], obj) (readJSPath path)       where err (cxt, msg) = hPutStrLn stderr $ (showString msg . showString "\nLocation in the structure: " . showJSPath (pathFromContext cxt)) ""     _ -> usage "Too many arguments"
json-strings.hs view
@@ -1,22 +1,26 @@-import Text.JSON.AttoJSON-import qualified Data.ByteString as S+import Data.Aeson+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Monoid+import Data.Maybe import Data.Foldable hiding (mapM_) import Control.Monad (when) import System.IO (hPutStrLn, stderr) import System.Environment (getArgs) import System.Exit (exitFailure)+import qualified Data.Text as T+import qualified Data.Vector as V  -- NOTE that the map keys are not included -jsonStrings :: JSValue -> [S.ByteString]+jsonStrings :: Value -> [T.Text] 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+  where go (String s) = Endo (s:)+        go (Number _) = mempty+        go (Bool   _) = mempty+        go Null       = mempty+        go (Object m) = foldMap go m+        go (Array xs) = foldMap go xs  usage :: IO a usage = mapM_ (hPutStrLn stderr)@@ -30,9 +34,10 @@ main = do   args <- getArgs   when (not . null $ args) usage-  S.putStrLn . showJSON             -- printing the output-     . JSArray . map JSString       -- building the result+  L8.putStrLn . encode              -- printing the output+     . Array . V.fromList           -- building the result+     . map String                   -- building the elements      . jsonStrings                  -- main processing-     . either err id                -- error handling-     . parseJSON =<< S.getContents  -- reading the input-  where err = error . ("JSON parsing: "++)+     . fromMaybe err                -- error handling+     . decode' =<< L.getContents    -- reading the input+  where err = error "JSON parsing"
json-tools.cabal view
@@ -1,6 +1,6 @@ Name:           json-tools Cabal-Version:  >=1.6-Version:        0.3.1+Version:        0.4.0 License:        BSD3 License-File:   LICENSE Copyright:      (c) Nicolas Pouillard@@ -14,34 +14,34 @@  executable json-concat     main-is: json-concat.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring+    Build-depends: base>=3&&<5, aeson, 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+    Build-depends: base>=3&&<5, aeson, bytestring, containers     ghc-options: -Wall -Odph  executable json-select     main-is: json-select.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring, containers+    Build-depends: base>=3&&<5, aeson, bytestring, containers     ghc-options: -Wall -Odph  executable json-iter     main-is: json-iter.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring, process+    Build-depends: base>=3&&<5, aeson, bytestring, process     Other-modules: Utils     ghc-options: -Wall -Odph  executable json-lines     main-is: json-lines.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring+    Build-depends: base>=3&&<5, aeson, bytestring     Other-modules: Utils     ghc-options: -Wall -Odph  executable json-strings     main-is: json-strings.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring+    Build-depends: base>=3&&<5, aeson, bytestring     ghc-options: -Wall -Odph  executable json-unlines@@ -52,17 +52,23 @@  executable json-wrap     main-is: json-wrap.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring+    Build-depends: base>=3&&<5, aeson, bytestring, vector     ghc-options: -Wall -Odph  executable json-xargs     main-is: json-xargs.hs-    Build-depends: base>=3&&<5, AttoJson, bytestring+    Build-depends: base>=3&&<5, aeson, 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+    Build-depends: base>=3&&<5, bytestring, aeson, unordered-containers,+                   text, tar>=0.4.0+    ghc-options: -Wall -Odph++executable json-quote+    main-is: json-quote.hs+    Build-depends: base>=3&&<5, aeson, text     ghc-options: -Wall -Odph  source-repository head
json-unlines.hs view
@@ -4,7 +4,7 @@ import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO (hPutStrLn,stderr)-import Utils (readFilesL)+import Utils (readFiles)  usage :: IO a usage = mapM_ (hPutStrLn stderr)@@ -20,5 +20,5 @@   args <- getArgs   when ("--help"`elem`args) usage   L.putStrLn . L.cons '[' . L.intercalate "\n," . L.lines . L.concat-    =<< readFilesL args+    =<< readFiles args   L.putStrLn "]"
json-wrap.hs view
@@ -1,18 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} import Data.List (intersperse)-import Data.Map (toList) import Data.Monoid-import Text.JSON.AttoJSON-import qualified Data.ByteString as S+import Data.Aeson+import Data.Maybe+import qualified Data.HashMap.Strict as HM+import qualified Data.Vector as V+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8  -- wrap, as in line-wrapping  main :: IO ()-main = mapM_ S.putStr . ($["\n"]) . 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+main = mapM_ L.putStr . ($["\n"]) . f . fromMaybe err . decode' =<< L.getContents+  where f (Array a)   = t"[" . cat (intersperse (t"\n,") (map j . V.toList $ a)) . t"]"+        f (Object o)  = t"{" . cat (intersperse (t"\n,") (map g . HM.toList $ o)) . t"}"+        f _           = error "impossible by decodeStrict post-condition"+        g (key, val)  = t (encode key) . t(L8.pack ":") . j val+        j             = t . encode+        err           = error "JSON decoding"+        t x           = (x:)+        cat           = appEndo . mconcat . map Endo
json-xargs.hs view
@@ -1,6 +1,8 @@-import Text.JSON.AttoJSON-import qualified Data.ByteString.Char8 as S+import Data.Aeson+import qualified Data.ByteString.Lazy as L+import Data.Text as T import Data.Monoid+import Data.Maybe import Data.Foldable import Data.Functor import System.Environment@@ -9,20 +11,20 @@  -- NOTE that the map keys are not included -jsonArgs :: JSValue -> [String]+jsonArgs :: Value -> [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+  where go (String s) = f (T.unpack s)+        go (Number n) = f (show n)+        go (Bool   b) = f (if b then "true" else "false")+        go Null       = f "null"+        go (Object m) = foldMap go m+        go (Array 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+          args <- jsonArgs                   -- main processing+                . fromMaybe err              -- error handling+                . decode' <$> L.getContents  -- reading the input           exitWith =<< rawSystem cmd (argv ++ args)-  where err = error . ("JSON parsing: "++)+  where err = error "Invalid JSON input"
tar2json.hs view
@@ -1,26 +1,26 @@ 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.HashMap.Strict as HM+import qualified Data.Aeson as Aeson+import qualified Data.Text as T 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+{-TODO currently does not work for binary files-} -  entries :: Tar.Entries -> [(S.ByteString, Maybe JsonObject)]+tar2json :: Tar.Entries FormatError -> Aeson.Value+tar2json es0 = Aeson.Object $ HM.fromList [(k,v) | (k,Just v) <- entries es0] where++  entries :: Tar.Entries FormatError -> [(T.Text, Maybe Aeson.Value)]   entries Done         = []-  entries (Fail s)     = error s+  entries (Fail s)     = error . show $ 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+  path :: Tar.Entry -> T.Text+  path = T.pack . entryPath -  contents :: Tar.Entry -> Maybe JsonObject-  contents = fmap (Scalar . JsonString) . f . entryContent where-    f (NormalFile s _) = Just (convertSuccess s)+  contents :: Tar.Entry -> Maybe Aeson.Value+  contents = fmap Aeson.toJSON . f . entryContent where+    f (NormalFile s _) = Just s     f _                = Nothing  main :: IO ()@@ -28,8 +28,8 @@  = do hPutStrLn stderr "Reading standard input..."       hSetEncoding stdin latin1       hSetEncoding stdout latin1-      S.putStr            -- printing output-       . Json.encode      -- producing JSON+      L.putStr            -- printing output+       . Aeson.encode     -- producing JSON        . tar2json         -- main translation        . Tar.read         -- reading the archive        =<< L.getContents  -- reading the input