packages feed

spreadsheet 0.1.3.5 → 0.1.3.6

raw patch · 7 files changed

+269/−77 lines, 7 filesdep +containersdep +optparse-applicativedep ~basedep ~transformersdep ~utility-htnew-component:exe:csvextract

Dependencies added: containers, optparse-applicative

Dependency ranges changed: base, transformers, utility-ht

Files

README.md view
@@ -67,3 +67,31 @@ ~~~~ LANG=de_DE csvreplace --multifile=FIRSTNAME-SURNAME.txt template.txt <names.csv ~~~~+++## Example: `csvextract`++This is somehow the inverse of `csvreplace`.+Given a text file that was generated+by substituting placeholders in a regular way.+You can then obtain back a CSV file.++E.g. take the example files from `csvreplace` and call++~~~~+csvreplace template.txt <names.csv | csvextract --columns FIRSTNAME,SURNAME,BIRTH template.txt+~~~~++You should get back `names.csv`.++This is, how it works:+The text in `template.txt` is first divided into text and placeholders+according to the comma separated list of names for the `--columns` option.+Then the program matches the template fragments with the input text+and assigns the text between template fragments to the placeholders.+Placeholder replacements are chosen as short as possible+in a greedy way, i.e. per placeholder, not globally.++If you want to skip larger portions of the input text,+you may use a placeholder like `SKIP` in `template.txt`+and call `csvextract` with the option `--ignore SKIP`.
+ example/CSVExtract.hs view
@@ -0,0 +1,72 @@+module Main where++import qualified CSVExtract.Option as Option+import qualified Options.Applicative as OP++import qualified Data.Spreadsheet as Sheet++import Control.Monad (msum, )+import Control.Applicative ((<$>), )+import Control.Functor.HT (outerProduct, )++import qualified Data.List.HT as ListHT+import qualified Data.List as List+import qualified Data.Map as Map+import Data.Map (Map, )+import Data.Maybe (fromMaybe, )+import Data.Tuple.HT (mapFst, )+++divideTemplate :: [String] -> String -> (String, [(String, String)])+divideTemplate placeholders =+   let go [] = ([], [])+       go str@(s:ss) =+         fromMaybe+            (mapFst (s:) $ go ss)+            (msum $+             flip map placeholders $ \placeholder ->+               (\ ~(text,remain) -> ([], (placeholder,text) : remain)) . go <$>+               ListHT.maybePrefixOf placeholder str)+   in  go++searchFirst :: String -> String -> Maybe String+searchFirst text = msum . map (ListHT.maybePrefixOf text) . ListHT.tails++searchNext :: String -> String -> (String, Maybe String)+searchNext text =+   let go [] = ([], Nothing)+       go str@(s:ss) =+         case ListHT.maybePrefixOf text str of+            Nothing -> mapFst (s:) $ go ss+            Just remain -> ([], Just remain)+   in  go++extractRow ::+   (String, [(String, String)]) -> String -> Maybe (Map String String, String)+extractRow (firstPart, parts) str0 =+   flip fmap (searchFirst firstPart str0) $+      let go m [] str1 = (m,str1)+          go m ((placeholder,text):phs) str1 =+            case searchNext text str1 of+               (_, Nothing) -> (m,"")+               (content, Just remain) ->+                  go (Map.insert placeholder content m) phs remain+      in  go Map.empty parts++extract :: (String, [(String, String)]) -> String -> [Map String String]+extract template = List.unfoldr (extractRow template)+++main :: IO ()+main = do+   opt <- OP.execParser $ Option.info Option.parser+   let placeholders = ListHT.chop (','==) $ Option.columns opt+   let ignore = ListHT.chop (','==) $ Option.ignore opt+   template <- readFile $ Option.template opt+   interact $ \input ->+      Sheet.toString (Option.quotation opt) (Option.delimiter opt) $+      (if Option.header opt then (placeholders:) else id) $+      outerProduct+         (\row placeholder -> Map.findWithDefault "" placeholder row)+         (extract (divideTemplate (placeholders++ignore) template) input)+         placeholders
+ example/CSVExtract/Option.hs view
@@ -0,0 +1,48 @@+module CSVExtract.Option where++import qualified Option+import qualified Options.Applicative as OP++import Control.Applicative (pure, (<*>))++import Data.Monoid ((<>))+++info :: OP.Parser a -> OP.ParserInfo a+info p =+   OP.info+      (OP.helper <*> p)+      (OP.fullDesc <>+       (OP.progDesc $+         "Extract CSV table using a text template. " +++         "The filled formular is read from standard input."))++parser :: OP.Parser Option+parser =+   pure Option+   <*> (OP.strOption $+         OP.long "columns" <>+         OP.metavar "COMMALIST" <>+         OP.help "Names for columns and placeholders")+   <*> (OP.strOption $+         OP.long "ignore" <>+         OP.metavar "COMMALIST" <>+         OP.value "" <>+         OP.help "Names for ignored placeholders")+   <*> (OP.switch $+         OP.long "header" <>+         OP.help "Emit column headers")+   <*> Option.delimiter+   <*> Option.quotation+   <*> (OP.strArgument $+         OP.metavar "TEMPLATE" <>+         OP.help "Template file")+++data Option =+   Option {+      columns, ignore :: String,+      header :: Bool,+      delimiter, quotation :: Char,+      template :: FilePath+   }
example/CSVReplace.hs view
@@ -1,71 +1,27 @@ module Main where +import qualified CSVReplace.Option as Option+import qualified Options.Applicative as OP+ 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 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 Control.Applicative ((<$>), )  import qualified Data.Foldable as Fold 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@@ -75,27 +31,19 @@   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 <- lift $ readFile templateName-            sheet <--               Sheet.fromString (optQuotation flags) (optDelimiter flags) <$>-               lift getContents-            case AExc.result sheet of-               [] -> Exc.throwT "empty CSV input"-               names:rows ->-                  lift $-                  case optMultiFile flags of-                     Nothing -> putStr $ replace template names rows-                     Just filePattern ->-                        forM_ rows $ \row ->-                           writeFile (replaceRow filePattern names row) $-                              replaceRow template names row-            Fold.mapM_ Exc.throwT $ AExc.exception sheet-         _ -> Exc.throwT "I need exactly one template file."+main = do+   opt <- OP.execParser $ Option.info Option.parser+   template <- readFile $ Option.template opt+   sheet <-+      Sheet.fromString (Option.quotation opt) (Option.delimiter opt) <$>+      getContents+   case AExc.result sheet of+      [] -> exitFailureMsg "empty CSV input"+      names:rows ->+         case Option.multiFile opt of+            Nothing -> putStr $ replace template names rows+            Just filePattern ->+               forM_ rows $ \row ->+                  writeFile (replaceRow filePattern names row) $+                     replaceRow template names row+   Fold.mapM_ exitFailureMsg $ AExc.exception sheet
+ example/CSVReplace/Option.hs view
@@ -0,0 +1,40 @@+module CSVReplace.Option where++import qualified Option+import qualified Options.Applicative as OP++import Control.Applicative (pure, (<*>), (<$>))++import Data.Monoid ((<>))+++info :: OP.Parser a -> OP.ParserInfo a+info p =+   OP.info+      (OP.helper <*> p)+      (OP.fullDesc <>+       (OP.progDesc $+         "Replace placeholders in a text file according to a CSV table. " +++         "The CSV file is read from standard input."))++parser :: OP.Parser Option+parser =+   pure Option+   <*> (OP.option (Just <$> OP.str) $+         OP.long "multifile" <>+         OP.metavar "FILEPATTERN" <>+         OP.value Nothing <>+         OP.help "Generate one file per CSV row")+   <*> Option.delimiter+   <*> Option.quotation+   <*> (OP.strArgument $+         OP.metavar "TEMPLATE" <>+         OP.help "Template file")+++data Option =+   Option {+      multiFile :: Maybe FilePath,+      delimiter, quotation :: Char,+      template :: FilePath+   }
+ example/Option.hs view
@@ -0,0 +1,33 @@+module Option where++import qualified Options.Applicative as OP++import Data.Monoid ((<>))+++delimiter :: OP.Parser Char+delimiter =+   OP.option (character "delimiter") $+      OP.short 'd' <>+      OP.long "delimiter" <>+      OP.metavar "CHAR" <>+      OP.value ',' <>+      OP.help "Field delimiter character"++quotation :: OP.Parser Char+quotation =+   OP.option (character "quotation") $+      OP.short 'q' <>+      OP.long "quotation" <>+      OP.metavar "CHAR" <>+      OP.value '"' <>+      OP.help "Quotation mark character"++character :: String -> OP.ReadM Char+character name =+   OP.eitherReader $ \str ->+   case str of+      [c] -> Right c+      "\\t" -> Right '\t'+      _ -> Left $+         name ++ " must be one character, which " ++ show str ++ " is not"
spreadsheet.cabal view
@@ -1,5 +1,5 @@ Name:             spreadsheet-Version:          0.1.3.5+Version:          0.1.3.6 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -16,9 +16,11 @@   .   > cabal install -fbuildExamples   .-  then the example program @csvreplace@ is compiled and installed, too.-  This program fills a template text using data from a CSV file.+  then the example programs @csvreplace@ and @csvextract@+  are compiled and installed, too.+  The program @csvreplace@ fills a template text using data from a CSV file.   For similar (non-Haskell) programs see @cut@, @csvfix@, @csvtool@.+  The program @csvextract@ is the inverse of @csvreplace@.   .   Related packages:   .@@ -42,7 +44,7 @@   Location: http://code.haskell.org/~thielema/spreadsheet/  Source-Repository this-  Tag:      0.1.3.5+  Tag:      0.1.3.6   Type:     darcs   Location: http://code.haskell.org/~thielema/spreadsheet/ @@ -75,11 +77,32 @@   If flag(buildExamples)     Build-Depends:       spreadsheet,+      optparse-applicative >=0.12 && <0.15,       utility-ht,-      transformers,       explicit-exception,       base   Else     Buildable:      False   GHC-Options:      -Wall-  Main-Is: example/CSVReplace.hs+  Hs-Source-Dirs:   example+  Main-Is: CSVReplace.hs+  Other-Modules:+    CSVReplace.Option+    Option++Executable csvextract+  If flag(buildExamples)+    Build-Depends:+      spreadsheet,+      optparse-applicative >=0.12 && <0.15,+      containers >=0.4.2 && <0.6,+      utility-ht,+      base+  Else+    Buildable:      False+  GHC-Options:      -Wall+  Hs-Source-Dirs:   example+  Main-Is: CSVExtract.hs+  Other-Modules:+    CSVExtract.Option+    Option