cutter (empty) → 0.0

raw patch · 4 files changed

+186/−0 lines, 4 filesdep +basedep +bytestringdep +explicit-exceptionsetup-changed

Dependencies added: base, bytestring, explicit-exception, spreadsheet, utility-ht

Files

LICENSE +30/−0
Setup.lhs +3/−0
cutter.cabal +51/−0
src/Main.hs +102/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Henning Thielemann++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 Henning Thielemann 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.lhs view

@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

+ cutter.cabal view

@@ -0,0 +1,51 @@+Name:                cutter+Version:             0.0+Synopsis:            Cut files according to a position list+Description:+  Cut a file into chunks according to a position list+  and concatenate the chunks.+  The chunks must not overlap and must be in increasing order.+  .+  Use it this way:+  .+  > cutter positions.csv <datain >dataout+  .+  The file @positions.csv@ must be a comma separated spreadsheet file (CSV),+  where the first column contains the chunk beginnings+  and the second column contains the pause beginnings.+  A pause begins one byte after a chunk ends.+  The other columns are ignored and may contain annotations of the chunks.+  .+  The positions file may also contain line numbers.+  In this case you run the command this way:+  .+  > cutter -l positions.csv <datain >dataout+  .+  Example: remove selected attachments from e-mails in mbox file+  using the @lsmbox@ command from <http://hackage.haskell.org/package/mbox-utility>.+License:             BSD3+License-File:        LICENSE+Author:              Henning Thielemann+Maintainer:          haskell@henning-thielemann.de+Category:            Console+Build-Type:          Simple+Cabal-Version:       >=1.8++Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/cutter/++Source-Repository head+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/cutter/++Executable cutter+  Main-Is: src/Main.hs+  GHC-Options: -Wall+  Build-Depends:+    spreadsheet >=0.1.3 && <0.2,+    explicit-exception >=0.1.6 && <0.2,+    bytestring >=0.9.1 && <0.11,+    utility-ht >=0.0.7 && <0.1,+    base >=4.2 && <5

+ src/Main.hs view

@@ -0,0 +1,102 @@+module Main where++import qualified Data.Spreadsheet as Spreadsheet+import qualified Control.Monad.Exception.Synchronous as ExcSync+import qualified Control.Monad.Exception.Asynchronous as ExcAsync+import qualified Data.ByteString.Lazy.Char8 as BC+import qualified Data.List as List+import Control.Monad (liftM2, )+import Data.Foldable (fold, foldMap, forM_, )+import Data.Monoid (Monoid, mconcat, )+import Data.Tuple.HT (swap, )++import qualified System.Environment as Env+import qualified System.Exit as Exit+import qualified System.IO as IO++import Prelude hiding (take, drop, splitAt)+++parseInteger :: String -> ExcSync.Exceptional String Integer+parseInteger str =+   case reads str of+      [(n, "")] -> return n+      _ -> ExcSync.throw (show str ++ " is not an integer")++parseCSVRow :: [String] -> ExcSync.Exceptional String (Integer, Integer)+parseCSVRow (from:to:_) = liftM2 (,) (parseInteger from) (parseInteger to)+parseCSVRow _ = ExcSync.throw "line contains less than two columns"++parsePositions :: String -> ExcAsync.Exceptional String [(Integer, Integer)]+parsePositions =+   flip ExcAsync.simultaneousBind+      (foldMap (ExcAsync.fromSynchronousMonoid . fmap (:[]) . parseCSVRow)) .+   Spreadsheet.fromString '"' ','++subtractPositions ::+   [(Integer, Integer)] -> ExcAsync.Exceptional String [(Integer, Integer)]+subtractPositions xs =+   fold $+   zipWith+      (\oldStop (start, stop) -> ExcAsync.fromSynchronousMonoid $ do+         ExcSync.assert "overlapping chunks or non-increasing positions" (oldStop<=start)+         ExcSync.assert "negative chunks size" (start<=stop)+         return [(start-oldStop, stop-start)])+      (0 : map snd xs) xs+++class Monoid a => Cut a where+   drop :: Integer -> a -> a+   splitAt :: Integer -> a -> (a, a)++instance Cut [a] where+   drop = List.genericDrop+   splitAt = List.genericSplitAt++instance Cut BC.ByteString where+   drop n = BC.drop (fromInteger n)+   splitAt n = BC.splitAt (fromInteger n)+++makeCutter ::+   (Cut a) =>+   FilePath ->+   IO (a -> ExcAsync.Exceptional String a)+makeCutter posFile = do+   posTxt <- readFile posFile+   return $ \xs0 ->+      flip fmap+         (ExcAsync.simultaneousBind (parsePositions posTxt) subtractPositions)+         (mconcat . snd .+          List.mapAccumL+             (\xs (a,b) -> swap $ splitAt b $ drop a xs)+             xs0)+++exitFailureMsg :: String -> IO ()+exitFailureMsg msg = do+   IO.hPutStrLn IO.stderr msg+   Exit.exitFailure++interactExc ::+   (BC.ByteString -> ExcAsync.Exceptional String BC.ByteString) -> IO ()+interactExc f = do+   x <- fmap f BC.getContents+   case x of+      ExcAsync.Exceptional e a -> do+         BC.putStr a+         forM_ e exitFailureMsg++main :: IO ()+main = do+   args <- Env.getArgs+   case args of+      [positions] ->+         makeCutter positions >>= interactExc+      ["-c", positions] ->+         makeCutter positions >>= interactExc+      ["-l", positions] -> do+         cutter <- makeCutter positions+         interactExc (fmap BC.unlines . cutter . BC.lines)+      _ -> do+         exitFailureMsg "no position file given"