spreadsheet-0.1.3: src/CSVReplace.hs

module Main where

import qualified Data.Spreadsheet as Sheet
import qualified Data.List.HT as ListHT

import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )
import System.Environment (getArgs, getProgName, )
import qualified System.Exit as Exit
import qualified System.IO as IO

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL

import qualified Control.Monad.Exception.Asynchronous as AExc
import qualified Control.Monad.Exception.Synchronous as Exc
import Control.Monad.Trans.Class (lift, )
import Control.Monad (when, )
import Data.Foldable (forM_, )


data Flags =
   Flags {
      optMultiFile :: Maybe FilePath,
      optQuotation,
      optDelimiter :: Char
   }

defltFlags :: Flags
defltFlags = Flags {
      optMultiFile = Nothing,
      optQuotation = '"',
      optDelimiter = ','
   }

exitFailureMsg :: String -> IO a
exitFailureMsg msg = do
   IO.hPutStrLn IO.stderr msg
   Exit.exitFailure

options :: [OptDescr (Flags -> IO Flags)]
options =
   Option ['h'] ["help"]
      (NoArg (\_ -> do
         programName <- getProgName
         putStrLn $ flip usageInfo options $
            "Usage: " ++ programName ++ " [OPTIONS] TEMPLATE-FILE\n" ++
            "The CSV file is read from standard input.\n"
         Exit.exitSuccess))
      "show options" :
   Option [] ["multifile"]
      (flip ReqArg "FILEPATTERN" $ \str flags ->
         return $ flags{optMultiFile = Just str})
      "generate one file per CSV row" :
   Option ['d'] ["delimiter"]
      (flip ReqArg "CHAR" $ \str flags -> do
         case str of
            [c] -> return $ flags{optDelimiter = c}
            _ -> exitFailureMsg $ "delimiter must be one character, which " ++ show str ++ " is not")
      "field delimiter character" :
   Option ['q'] ["quotation"]
      (flip ReqArg "CHAR" $ \str flags -> do
         case str of
            [c] -> return $ flags{optQuotation = c}
            _ -> exitFailureMsg $ "quotation mark must be one character, which " ++ show str ++ " is not")
      "quotation mark character" :
   []


replaceRow :: String -> [String] -> [String] -> String
replaceRow template names row =
   ListHT.multiReplace (filter (not . null . fst) $ zip names row) template

replace :: String -> [String] -> Sheet.T -> String
replace template names =
   concatMap (replaceRow template names)


main :: IO ()
main =
   Exc.resolveT (\e -> exitFailureMsg $ "Aborted: " ++ e) $ do
      argv <- lift getArgs
      let (opts, files, errors) = getOpt RequireOrder options argv
      when (not (null errors)) $ Exc.throwT $ concat $ errors
      flags <- lift $ foldr (=<<) (return defltFlags) opts
      case files of
         [templateName] -> do
            template <- fmap B.unpack $ lift $ B.readFile templateName
            sheet <-
               fmap (Sheet.fromString (optQuotation flags) (optDelimiter flags)
                      . BL.unpack) $
               lift BL.getContents
            case AExc.result sheet of
               [] -> Exc.throwT "empty CSV input"
               (names:rows) ->
                  case optMultiFile flags of
                     Nothing -> do
                        lift $ putStr $ replace template names rows
                        forM_ (AExc.exception sheet) $ Exc.throwT
                     Just filePattern ->
                        lift $ forM_ rows $ \row ->
                           writeFile (replaceRow filePattern names row) $
                              replaceRow template names row
         _ -> Exc.throwT "I need exactly one template file."