Merge pull request #6 from danslapman/feature/progressbar

Add ProgressBar

Author: danslapman

app/Main.hs

@@ -10,9 +10,9 @@ import qualified Data.ByteString.Lazy as LBS
 import Data.Either
 import Data.Foldable (toList)
 import qualified Data.HashMap.Strict as HM
-import Data.IORef
 import Data.HashSet (HashSet, empty, intersection, null, union)
 import qualified Data.HashSet as HS (toList)
+import Data.IORef
 import Data.Text (Text, intercalate)
 import qualified Data.Text.IO as TIO
 import Deque.Strict (Deque)
@@ -21,28 +21,31 @@ import GHC.Exts (fromList)
 import Json2Csv
 import Options.Applicative hiding (empty)
 import Options.Applicative.Text
-import Prelude hiding (foldl, foldl', map, null, sequence)
 import Schema
 import System.IO
+import System.ProgressBar
+import Prelude hiding (foldl, foldl', map, null, sequence)
 
-data Args = Args {
-  jsonFile :: String,
-  csvFile :: String,
-  separator :: Text,
-  isect :: Bool,
-  flatArr :: Bool
-}
+data Args = Args
+  { jsonFile :: String,
+    csvFile :: String,
+    separator :: Text,
+    isect :: Bool,
+    flatArr :: Bool
+  }
 
 type PathSet = HashSet JsonPath
+
 type PathSetCombine = PathSet -> PathSet -> PathSet
 
 args :: Parser Args
-args = Args 
-  <$> strArgument (metavar "jsonFile" <> help "Newline-delimited JSON input file name")
-  <*> strArgument (metavar "csvFile" <> help "CSV output file name")
-  <*> textOption (long "separator" <> help "CSV separator" <> showDefault <> value ";")
-  <*> switch (long "intersect" <> short 'i' <> help "\"Inner join\" fields while constructing schema")
-  <*> switch (long "flatten" <> short 'f' <> help "Flatten array iterators")
+args =
+  Args
+    <$> strArgument (metavar "jsonFile" <> help "Newline-delimited JSON input file name")
+    <*> strArgument (metavar "csvFile" <> help "CSV output file name")
+    <*> textOption (long "separator" <> help "CSV separator" <> showDefault <> value ";")
+    <*> switch (long "intersect" <> short 'i' <> help "\"Inner join\" fields while constructing schema")
+    <*> switch (long "flatten" <> short 'f' <> help "Flatten array iterators")
 
 argsInfo :: ParserInfo Args
 argsInfo = info args fullDesc
@@ -59,31 +62,35 @@ main = do
   let combine = if (isect arguments) then isectOrNonEmpty else flip union
   let flat = flatArr arguments
   let procCols = if (flat) then dropIterators else id
-  header <- withFile (jsonFile arguments) ReadMode $ computeHeaderMultiline combine
+  (header, numberOfLines) <- withFile (jsonFile arguments) ReadMode $ computeHeaderMultiline combine
   let schema = toSchema header
   let columns = jsonPathText <$> (uniq $ procCols <$> header)
+  pb <- newProgressBar defStyle 10 (Progress 0 numberOfLines ())
   withFile (jsonFile arguments) ReadMode $ \hIn ->
     withFile (csvFile arguments) WriteMode $ \hOut -> do
       hSetEncoding hIn utf8
       hSetEncoding hOut utf8
       TIO.hPutStrLn hOut $ mkSepString $ columns
-      whileM_ (not <$> hIsEOF hIn) (parseAndWriteEntry mkSepString flat schema columns hIn hOut)
+      whileM_ (not <$> hIsEOF hIn) $ do
+        (parseAndWriteEntry mkSepString flat schema columns hIn hOut)
+        incProgress pb 1
 
-computeHeaderMultiline :: PathSetCombine -> Handle -> IO (Deque JsonPath)
+computeHeaderMultiline :: PathSetCombine -> Handle -> IO (Deque JsonPath, Int)
 computeHeaderMultiline combine handle = do
   currentLineNumber <- newIORef (0 :: Int)
   pathSet <- newIORef (empty :: HashSet JsonPath)
   whileM_ (not <$> hIsEOF handle) $ do
-      modifyIORef' currentLineNumber (1+)
-      line <- LBS.fromStrict <$> BS.hGetLine handle
-      ln <- readIORef currentLineNumber
-      parsed <- case eitherDecode' line of
-                         Right value -> pure value
-                         Left err -> fail $ "Can't parse JSON at line " ++ (show ln) ++ ": " ++ err
-      let (Just header) = computePaths True parsed
-      modifyIORef' pathSet (combine header)
+    modifyIORef' currentLineNumber (1 +)
+    line <- LBS.fromStrict <$> BS.hGetLine handle
+    ln <- readIORef currentLineNumber
+    parsed <- case eitherDecode' line of
+      Right value -> pure value
+      Left err -> fail $ "Can't parse JSON at line " ++ (show ln) ++ ": " ++ err
+    let (Just header) = computePaths True parsed
+    modifyIORef' pathSet (combine header)
   pathes <- readIORef pathSet
-  return $ fromList . HS.toList $ pathes
+  numberOfLines <- readIORef currentLineNumber
+  return (fromList . HS.toList $ pathes, numberOfLines)
 
 parseAndWriteEntry :: (Deque Text -> Text) -> Bool -> JsonSchema -> Deque Text -> Handle -> Handle -> IO ()
 parseAndWriteEntry mkSepString flat schema columns hIn hOut = do

package.yaml

@@ -35,6 +35,7 @@ dependencies:
 - deepseq
 - optparse-applicative
 - optparse-text
+- terminal-progress-bar
 
 library:
   source-dirs: src

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-19.14
+resolver: lts-19.31
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.