diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,24 +0,0 @@ -Copyright 2013, Ingolf Wagner -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. - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND THE 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 AUTHOR OR THE -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. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,14 @@ +This file is part of csv-to-qif. + +csv-to-qif is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +csv-to-qif is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with csv-to-qif. If not, see . diff --git a/csv-to-qif.cabal b/csv-to-qif.cabal --- a/csv-to-qif.cabal +++ b/csv-to-qif.cabal @@ -1,14 +1,14 @@ name: csv-to-qif -version: 0.3.2 +version: 0.3.3 cabal-version: >=1.10 build-type: Simple license: BSD3 -license-file: LICENSE +license-file: LICENSE.txt copyright: (c) Ingolf Wagner -maintainer: Ingolf Wagner +maintainer: Ingolf Wagner stability: stable -homepage: https://github.com/mrVanDalo/csv-to-qif/ -bug-reports: mailto:palipalo9@gmail.com +homepage: http://mrvandalo.github.io/csv-to-qif/ +bug-reports: mailto:csv-to-qif@ingolf-wagner.de synopsis: A small program that will read csv files and create qif files description: Binary to convert a wide range of csv files to qif files. The main target is to read them into GnuCash. @@ -16,6 +16,19 @@ author: Ingolf Wagner data-dir: "" +tested-With: GHC == 7.10.1 + , GHC == 7.10.2 + , GHC == 7.10.3 + , GHC == 7.6.1 + , GHC == 7.6.2 + , GHC == 7.6.3 + , GHC == 7.8.1 + , GHC == 7.8.2 + , GHC == 7.8.3 + , GHC == 7.8.4 + , GHC == 8.0.1 + , GHC == 8.0.2 + source-repository head type: git location: git@github.com:mrVanDalo/csv-to-qif.git @@ -28,29 +41,41 @@ split >= 0.2.2, regex-tdfa >= 1.2.0, spreadsheet >= 0.1.3.3, - explicit-exception >= 0.1.7 + explicit-exception >= 0.1.7, + parsec >= 3.1.7 if flag(threaded) buildable: True ghc-options: -threaded + main-is: Main.hs buildable: True default-language: Haskell2010 - hs-source-dirs: src main - other-modules: Main Parser QifOptions Qifer + hs-source-dirs: main src + other-modules: QifOptions + Parser + QifData + Qifer test-suite tester - build-depends: base >= 4.6 && < 5, - split >= 0.2.2, - regex-tdfa >= 1.2.0, - Cabal >= 1.9.2, - hspec >= 1.8 + build-depends: base >= 4.6 && < 5, + split >= 0.2.2, + regex-tdfa >= 1.2.0, + Cabal >= 1.9.2, + hspec >= 1.8, + spreadsheet >= 0.1.3.3, + explicit-exception >= 0.1.7, + parsec >= 3.1.7, + QuickCheck >= 2.8.1 type: exitcode-stdio-1.0 - main-is: Tester.hs + + main-is: Main.hs buildable: True default-language: Haskell2010 default-extensions: OverloadedStrings - hs-source-dirs: src test - other-modules: Parser + hs-source-dirs: test src + other-modules: Parser + QifData + QifParser ghc-options: -Wall diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -8,113 +8,93 @@ -- Stability : unstable -- Portability : -- --- | --- ----------------------------------------------------------------------------- - -module Main (main) where - -import QifOptions -import Qifer -import Parser -import Data.List.Split - -import System.Environment -import System.Console.GetOpt -import System.IO -import Data.Maybe -import System.Exit - - +module Main + ( main + ) where +import Data.List.Split +import Data.Maybe +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO +import Parser +import Qifer +import QifOptions -- | the famous main method main = do - args <- getArgs - + args <- getArgs -- Parse options, getting a list of option actions - let (actions, nonOptions, errors) = getOpt RequireOrder options args - + let (actions, nonOptions, errors) = getOpt RequireOrder options args -- Here we thread startOptions through all supplied option actions - opts <- foldl (>>=) (return startOptions) actions - - let Options { optInput = input - , optOutput = output } = opts - - checkArguments opts - let rules = rule opts - - parseResult <- parseCSVFromFile (optSkip opts) (optInput opts) (optSeparator opts) - case parseResult of - Left error -> do - hPutStrLn stderr $ error - exitFailure - Right csv -> do - - let actions = toTransactions rules csv - - updatedActions <- case (optUpdater opts) of - Nothing -> - return $ actions - Just file -> do - updaterConfig <- readUpdaterFile file - return $ update updaterConfig actions - - let qif = transToQif updatedActions - - withFile (optOutput opts) WriteMode (\h -> - mapM_ ( hPutStrLn h) qif) - + opts <- foldl (>>=) (return startOptions) actions + let Options {optInput = input, optOutput = output} = opts + checkArguments opts + let rules = rule opts + parseResult <- + parseCSVFromFile (optSkip opts) (optInput opts) (optSeparator opts) + case parseResult of + Left error -> do + hPutStrLn stderr $ error + exitFailure + Right csv -> do + let actions = toTransactions rules csv + updatedActions <- + case (optUpdater opts) of + Nothing -> return $ actions + Just file -> do + updaterConfig <- readUpdaterFile file + return $ update updaterConfig actions + let qif = transToQif updatedActions + withFile (optOutput opts) WriteMode (\h -> mapM_ (hPutStrLn h) qif) -- | reads updater file -readUpdaterFile :: String -> IO [(String,String)] +readUpdaterFile :: String -> IO [(String, String)] readUpdaterFile fileName = do - content <- readFile fileName - return $ tupler . onlyTuple . splitter . lines $ content - where - tupler = map (\(x:(y:[])) -> (x,y)) - onlyTuple = filter (\l -> length l == 2) - splitter = map (\l -> splitOn "<->" l) - - - + content <- readFile fileName + return $ tupler . onlyTuple . splitter . lines $ content + where + tupler = map (\(x:(y:[])) -> (x, y)) + onlyTuple = filter (\l -> length l == 2) + splitter = map (\l -> splitOn "<->" l) -- | this function is unsafe call it after checkArguments -- @todo : make me safer rule :: Options -> Rule -rule opts = Rule { - dateField = fromJust $ optDate opts - , balanceField = fromJust $ optBalance opts - , textField = optLongText opts - , descField = optText opts - } +rule opts = + Rule + { dateField = fromJust $ optDate opts + , balanceField = fromJust $ optBalance opts + , textField = optLongText opts + , descField = optText opts + } -- | checks input arguments for minimum of configuration checkArguments :: Options -> IO () checkArguments opts = do - case errors of - [] -> - return () - _ -> do - mapM_ putStrLn errors - exitFailure - return () - where - errors = catMaybes list - list = [ (check optDate "need date column") - , (check optBalance "need balance column") - , (checkL optText "need text columns") - , (checkL optLongText "need long text columns") - , (checkL optInput "need input file") - ] - check getter text = case (getter opts) of - Nothing -> Just text - Just _ -> Nothing - checkL getter text = case (getter opts) of - [] -> Just text - _ -> Nothing - - - - + case errors of + [] -> return () + _ -> do + mapM_ putStrLn errors + exitFailure + return () + where + errors = catMaybes list + list = + [ (check optDate "need date column") + , (check optBalance "need balance column") + , (checkL optText "need text columns") + , (checkL optLongText "need long text columns") + , (checkL optInput "need input file") + ] + check getter text = + case (getter opts) of + Nothing -> Just text + Just _ -> Nothing + checkL getter text = + case (getter opts) of + [] -> Just text + _ -> Nothing diff --git a/main/QifOptions.hs b/main/QifOptions.hs --- a/main/QifOptions.hs +++ b/main/QifOptions.hs @@ -11,138 +11,139 @@ -- | -- ----------------------------------------------------------------------------- - module QifOptions where -import System.Console.GetOpt -import System.Exit -import System.IO -import System.Environment -import Control.Monad -import Text.Read -import Data.List.Split -import Data.Maybe - - +import Data.List.Split (splitOn) +import Data.Maybe (mapMaybe) +import System.Console.GetOpt (ArgDescr (..), OptDescr (..), usageInfo) +import System.Environment (getProgName) +import System.Exit (exitSuccess) +import System.IO (hPutStrLn, stderr) +import Text.Read (readMaybe) -data Options = Options { optVerbose :: Bool - , optInput :: String - , optOutput :: String - , optDate :: Maybe Int - , optBalance :: Maybe Int - , optText :: [Int] - , optLongText :: [Int] - , optSkip :: Int - , optSeparator :: Char - , optUpdater :: Maybe String - } deriving (Show) +data Options = Options + { optVerbose :: Bool + , optInput :: String + , optOutput :: String + , optDate :: Maybe Int + , optBalance :: Maybe Int + , optText :: [Int] + , optLongText :: [Int] + , optSkip :: Int + , optSeparator :: Char + , optUpdater :: Maybe String + } deriving (Show) startOptions :: Options -startOptions = Options { optVerbose = False - , optInput = "" - , optOutput = "" - , optDate = Nothing - , optBalance = Nothing - , optText = [] - , optLongText = [] - , optSkip = 0 - , optSeparator = ',' - , optUpdater = Nothing - } - ---instance Show (a -> b) where --- show _ = "" - -instance Show (IO a) where - show _ = "" - +startOptions = + Options + { optVerbose = False + , optInput = "" + , optOutput = "" + , optDate = Nothing + , optBalance = Nothing + , optText = [] + , optLongText = [] + , optSkip = 0 + , optSeparator = ',' + , optUpdater = Nothing + } -options :: [ OptDescr (Options -> IO Options) ] +options :: [OptDescr (Options -> IO Options)] options = - [ Option "i" ["input"] - (ReqArg - (\arg opt -> return opt { optInput = arg }) - "FILE") - "Input file (CSV Format)" - - , Option "o" ["output"] - (ReqArg - (\arg opt -> return opt { optOutput = arg }) - "FILE") - "Output file (Qif Format)" - - , Option "u" ["updater"] - (ReqArg - (\arg opt -> return opt { optUpdater = Just arg }) - "FILE") - "Updater file format is `match`<->`replacement`" - , Option "z" ["separator"] - (ReqArg - (\arg opt -> return opt { optSeparator = head arg }) - "char") - "separator of the csv file" - - , Option "d" ["date"] - (ReqArg - (\arg opt -> return opt { optDate = readColumn arg}) - "") - "Date Column" - , Option "b" ["balance"] - (ReqArg - (\arg opt -> return opt { optBalance = readColumn arg}) - "") - "Balance Column" - , Option "t" ["text"] - (ReqArg - (\arg opt -> return opt { optText = readColumns arg}) - "") - "Text Columns" - , Option "l" ["longtext"] - (ReqArg - (\arg opt -> return opt { optLongText = readColumns arg}) - "") - "Long Text Columns" - , Option "s" ["skip"] - (ReqArg - (\arg opt -> case (readColumn arg) of - Nothing -> return opt - Just r -> return opt { optSkip = r} ) - "") - "Rows to Skip before reading" - - , Option "v" ["verbose"] - (NoArg - (\opt -> return opt { optVerbose = True })) - "Enable verbose messages" - - , Option "V" ["version"] - (NoArg - (\_ -> do - hPutStrLn stderr "Version 0.2" - exitWith ExitSuccess)) - "Print version" - - , Option "h" ["help"] - (NoArg - (\_ -> do - prg <- getProgName - hPutStrLn stderr (usageInfo (useage prg) options) - exitWith ExitSuccess)) - "Show help" - ] + [ Option + "i" + ["input"] + (ReqArg (\arg opt -> return opt {optInput = arg}) "FILE") + "Input file (CSV Format)" + , Option + "o" + ["output"] + (ReqArg (\arg opt -> return opt {optOutput = arg}) "FILE") + "Output file (Qif Format)" + , Option + "u" + ["updater"] + (ReqArg (\arg opt -> return opt {optUpdater = Just arg}) "FILE") + "Updater file format is `match`<->`replacement`" + , Option + "z" + ["separator"] + (ReqArg (\arg opt -> return opt {optSeparator = head arg}) "char") + "separator of the csv file" + , Option + "d" + ["date"] + (ReqArg + (\arg opt -> return opt {optDate = readColumn arg}) + "") + "Date Column" + , Option + "b" + ["balance"] + (ReqArg + (\arg opt -> return opt {optBalance = readColumn arg}) + "") + "Balance Column" + , Option + "t" + ["text"] + (ReqArg + (\arg opt -> return opt {optText = readColumns arg}) + "") + "Text Columns" + , Option + "l" + ["longtext"] + (ReqArg + (\arg opt -> return opt {optLongText = readColumns arg}) + "") + "Long Text Columns" + , Option + "s" + ["skip"] + (ReqArg + (\arg opt -> + case readColumn arg of + Nothing -> return opt + Just r -> return opt {optSkip = r}) + "") + "Rows to Skip before reading" + , Option + "v" + ["verbose"] + (NoArg (\opt -> return opt {optVerbose = True})) + "Enable verbose messages" + , Option + "V" + ["version"] + (NoArg + (\_ -> do + hPutStrLn stderr "Version 0.2" + exitSuccess)) + "Print version" + , Option + "h" + ["help"] + (NoArg + (\_ -> do + prg <- getProgName + hPutStrLn stderr (usageInfo (useage prg) options) + exitSuccess)) + "Show help" + ] useage :: String -> String -useage prog = prog ++ "\n\n" ++ - "author : Ingolf Wagner\n\n" ++ - header ++ "\n\n" ++ - information ++ "\n\n" - where header = "Converting CSV files to Qif Files" - information = "all column numbers start at 0!" - +useage prog = + prog ++ + "\n\n" ++ + "author : Ingolf Wagner\n\n" ++ header ++ "\n\n" ++ information ++ "\n\n" + where + header = "Converting CSV files to Qif Files" + information = "all column numbers start at 0!" readColumn :: String -> Maybe Int -readColumn input = readMaybe input +readColumn = readMaybe readColumns :: String -> [Int] -readColumns input = catMaybes $ map readColumn $ splitOn "," input - +readColumns input = mapMaybe readColumn (splitOn "," input) diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} + ----------------------------------------------------------------------------- -- -- Module : Parser @@ -13,37 +14,32 @@ -- it's just a wrapper -- ----------------------------------------------------------------------------- - module Parser where -import Data.Char -import Data.Spreadsheet -import Control.Monad.Exception.Asynchronous.Lazy(Exceptional(..)) -import Data.List -import System.IO.Error -import System.IO - -import Qifer - - +import Control.Monad.Exception.Asynchronous.Lazy (Exceptional (..)) +import Data.Char (isSpace) +import Data.List (dropWhileEnd) +import Data.Spreadsheet (fromString) +import System.IO (hPutStrLn, stderr) +import Qifer (CSV) type ParseError = String -- | parse csv file to read transactions from it parseCSVFromFile :: Int -> String -> Char -> IO (Either ParseError CSV) parseCSVFromFile skip file separator = do - firstContent <- readFile file - let content = unlines . separatorAtEndFix . drop skip . lines $ firstContent - separatorAtEndFix = map (\l -> l ++ " ") - case (fromString '\n' separator content) of - Exceptional (Just s) result -> do - hPutStrLn stderr s - return $ Right $ strip result - Exceptional Nothing result -> return $ Right $ strip result + firstContent <- readFile file + let content = unlines . separatorAtEndFix . drop skip . lines $ firstContent + separatorAtEndFix = map (++ " ") + case fromString '\n' separator content of + Exceptional (Just s) res -> do + hPutStrLn stderr s + return $ Right $ strip res + Exceptional Nothing res -> return $ Right $ strip res strip :: CSV -> CSV -strip = map (\line -> map (\word -> stripWord word) line) - where stripWord = dropWhile dontNeed . dropWhileEnd dontNeed - dontNeed c = (c == '"') || (isSpace c) - +strip = map (map stripWord) + where + stripWord = dropWhile dontNeed . dropWhileEnd dontNeed + dontNeed c = (c == '"') || isSpace c diff --git a/src/QifData.hs b/src/QifData.hs new file mode 100644 --- /dev/null +++ b/src/QifData.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- +-- Module : QifData +-- Copyright : (c) Ingolf Wagner, (c) Jonathan Kochems +-- License : BSD3 +-- +-- Maintainer : Jonathan Kochems +-- Stability : unstable +-- Portability : +-- +-- +-- +----------------------------------------------------------------------------- +module QifData where + +data Qif = Qif + { typeinfo :: String + , transactions :: [Transaction] + } deriving (Eq, Show) + +typeinfoToString :: String -> String +typeinfoToString typevalue = "!Type:" ++ typevalue + +qifToLines :: Qif -> [String] +qifToLines qif = typeinfoToString tinfo : foo trans + where + tinfo = typeinfo qif + trans = transactions qif + foo [] = [] + foo (t:ts) = toQif t ++ ["^"] ++ foo ts + +qifToString :: Qif -> String +qifToString = unlines . qifToLines + +data Transaction = Transaction + { date :: String + , description :: String + , text :: String + , balance :: String + } deriving (Eq, Show) + +toQif :: Transaction -> [String] +toQif trans = ["P" ++ d, "T" ++ money, "D" ++ time, "M" ++ msg] + where + d = description trans + money = balance trans + time = date trans + msg = text trans diff --git a/src/Qifer.hs b/src/Qifer.hs --- a/src/Qifer.hs +++ b/src/Qifer.hs @@ -11,81 +11,68 @@ -- | -- ----------------------------------------------------------------------------- - module Qifer where -import Data.List -import Text.Regex.TDFA +import QifData (Qif (..), Transaction (..), qifToLines) +import Text.Regex.TDFA ((=~)) type CSV = [Row] + type Row = [Column] -type Column = String -data Transaction = Transaction { date :: String - , description :: String - , text :: String - , balance :: String - } deriving (Eq,Show) +type Column = String type Position = Int -data Rule = Rule { dateField :: Position - , descField :: [Position] - , textField :: [Position] - , balanceField :: Position - } deriving (Show) +data Rule = Rule + { dateField :: Position + , descField :: [Position] + , textField :: [Position] + , balanceField :: Position + } deriving (Show) highestPosition :: Rule -> Position -highestPosition (Rule dF tF ltF bF) = - maximum . concat $ [[dF],tF,ltF,[bF]] +highestPosition (Rule dF tF ltF bF) = maximum . concat $ [[dF], tF, ltF, [bF]] toTransactions :: Rule -> CSV -> [Transaction] -toTransactions _ [] = [] +toTransactions _ [] = [] toTransactions rule (c:sv) - | (highestPosition rule) >= (length c) = stepDeeper - | otherwise = transform : stepDeeper - where pick n = (c !! (n rule)) - pock n = concat . intersperse " " . map (\k -> c !! k ) $ (n rule) - stepDeeper = toTransactions rule sv - transform = (Transaction (pick dateField) - (pock descField) - (pock textField) - (pick balanceField)) - -qifHeader :: String -qifHeader = "!Type:Bank" - -toQif :: Transaction -> [String] -toQif trans = ["P" ++ d, "T" ++ money, "D" ++ time, "M" ++ msg] - where d = (description trans) - money = (balance trans) - time = (date trans) - msg = (text trans) + | highestPosition rule >= length c = stepDeeper + | otherwise = transform : stepDeeper + where + pick n = c !! n rule + pock n = unwords . map (\k -> c !! k) $ n rule + stepDeeper = toTransactions rule sv + transform = + Transaction + (pick dateField) + (pock descField) + (pock textField) + (pick balanceField) transToQif :: [Transaction] -> [String] -transToQif trans = qifHeader : (foo trans) - where foo [] = [] - foo (t:ts) = (toQif t) ++ ["^"] ++ (foo ts) +transToQif trans = qifToLines Qif {typeinfo = "Bank", transactions = trans} -- | updates a Transaction if regex works updateTransaction :: String -> String -> Transaction -> Transaction updateTransaction regex replacement transaction = - transaction { description = updateDesc } - where - updateDesc = if matches then replacement else (description transaction) - matches = (description transaction) =~ regex :: Bool + transaction {description = updateDesc} + where + updateDesc = + if matches + then replacement + else description transaction + matches = description transaction =~ regex :: Bool -- | very inefficient but better than nothing -update :: [(String,String)] -> [Transaction] -> [Transaction] -update _ [] = [] -update regex (t:ts) = (updateSingle regex t) : (update regex ts) - where - updateSingle [] r = r - updateSingle ((rgx,replacement):rest) transaction = - if updatedTrans == transaction - then - updateSingle rest transaction - else - updatedTrans - where - updatedTrans = updateTransaction rgx replacement transaction +update :: [(String, String)] -> [Transaction] -> [Transaction] +update _ [] = [] +update regex (t:ts) = updateSingle regex t : update regex ts + where + updateSingle [] r = r + updateSingle ((rgx, replacement):rest) transaction = + if updatedTrans == transaction + then updateSingle rest transaction + else updatedTrans + where + updatedTrans = updateTransaction rgx replacement transaction diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,80 @@ +----------------------------------------------------------------------------- +-- +-- Module : Tester +-- Copyright : (c) Ingolf Wagner +-- License : BSD3 +-- +-- Maintainer : Ingolf Wagner +-- Stability : unstable +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Main (main) where + + +import Test.Hspec +import Test.QuickCheck +import Data.Char(isPrint) + +import Qifer +import QifData +import QifParser + + +main :: IO () +main = hspec $ + describe "Csv" $ do + it "should transform CSV" $ do + let rule = Rule 1 [2] [0,3] 4 + trans= Transaction "2" "3" "1 4" "5" + csv = [["1","2","3","4","5"]] + toTransactions rule csv `shouldBe` [trans] + it "should generate Qif" $ do + let trans = Transaction "heute" "short" "long bla bla" "100$" + _qif = ["Pshort","T100$","Dheute","Mlong bla bla"] + toQif trans `shouldBe` _qif + it "should generate Qif File content" $ do + let trans = Transaction "heute" "short" "long bla bla" "100$" + _qif = ["!Type:Bank","Pshort","T100$","Dheute","Mlong bla bla","^"] + transToQif [trans] `shouldBe` _qif + it "should update a transaction" $ do + let trans = Transaction "heute" "short" "long bla bla" "100$" + theUpdate = Transaction "heute" "bam" "long bla bla" "100$" + updateTransaction "ort" "bam" trans `shouldBe` theUpdate + updateTransaction "foo" "bam" trans `shouldBe` trans + it "should update multiple transactions" $ do + let transA = Transaction "heute" "short story long its .." "long bla bla" "100$" + transB = Transaction "morgen" "balla ball bam bam boom" "long bla bla" "100$" + transA1 = Transaction "heute" "found story" "long bla bla" "100$" + transB1 = Transaction "morgen" "found balla" "long bla bla" "100$" + regex = [("story","found story"),("balla","found balla")] + transactionsToTest = [transA,transB] + update regex transactionsToTest `shouldBe` [transA1,transB1] + it "taking a qif, printing it as a string, and parsing it should result in the original qif" $ + property $ forAll qif $ \qif -> qifFromString (qifToString qif) == qif + + + +transaction :: Gen Transaction +transaction = do + i <- choose(0,20) + j <- choose(0,20) + k <- choose(0,20) + m <- choose(0,20) + transactionDate <- suchThat (vector i) isText + transactionDescription <- suchThat (vector j) isText + transactionText <- suchThat (vector k) isText + transactionBalance <- suchThat (vector m) isText + return Transaction{ date = transactionDate, description = transactionDescription, text = transactionText , balance = transactionBalance } + +qif :: Gen Qif +qif = do i <- choose(0,20) + typeinfoToTest <- suchThat (vector i) isText + transactionsToTest <- listOf transaction + return Qif{ typeinfo = typeinfoToTest, transactions = transactionsToTest } + +isText :: String -> Bool +isText = all isPrint diff --git a/test/QifParser.hs b/test/QifParser.hs new file mode 100644 --- /dev/null +++ b/test/QifParser.hs @@ -0,0 +1,132 @@ +----------------------------------------------------------------------------- +-- +-- Module : QifParser +-- Copyright : (c) Jonathan Kochems +-- License : BSD3 +-- +-- Maintainer : Jonathan Kochems +-- Stability : unstable +-- Portability : +-- +-- +-- +----------------------------------------------------------------------------- +module QifParser where + +import QifData +import Text.ParserCombinators.Parsec + +{- ************************************************** + Parsers for transaction fields +*************************************************** -} +-- | Helper type to tag transaction field data +data TransactionField + = D String + | P String + | M String + | T String + +-- | Parser for date field in transaction +date_parser :: GenParser Char st TransactionField +date_parser = do + _ <- string "D" + date <- manyTill (noneOf ['\n', '\r']) (newline_or_eof) + return $ D date + +-- | Parser for description field in transaction +description_parser :: GenParser Char st TransactionField +description_parser = do + _ <- string "P" + description <- manyTill (noneOf ['\n', '\r']) newline_or_eof + return $ P description + +-- | Parser for text field in transaction +text_parser :: GenParser Char st TransactionField +text_parser = do + _ <- string "M" + text <- manyTill (noneOf ['\n', '\r']) newline_or_eof + return $ M text + +-- | Parser for balance field in transaction +balance_parser :: GenParser Char st TransactionField +balance_parser = do + _ <- string "T" + balance <- manyTill (noneOf ['\n', '\r']) newline_or_eof + return $ T balance + +{- ************************************************** + transactions +*************************************************** -} +-- | Parser for one whole transaction +transaction_parser :: GenParser Char st Transaction +transaction_parser = do + fields <- + manyTill + (choice [date_parser, description_parser, text_parser, balance_parser]) + (try $ lookAhead $ seperator_parser) + return $ + foldl + fieldToTransaction + Transaction {date = "", description = "", text = "", balance = ""} + fields + where + fieldToTransaction trans (D date) = trans {date = date} + fieldToTransaction trans (P desc) = trans {description = desc} + fieldToTransaction trans (M text) = trans {text = text} + fieldToTransaction trans (T bal) = trans {balance = bal} + +-- | Parser for transaction seperator '^' +seperator_parser :: GenParser Char st () +seperator_parser = do + _ <- string "^" + _ <- newline_or_eof + return () + +-- | Parser for a list of transactions +transactions_parser :: GenParser Char st [Transaction] +transactions_parser = sepEndBy transaction_parser seperator_parser + +{- ************************************************** + Qif file +*************************************************** -} +-- | Parser for type of qif (Bank, CCard, etc.) +type_parser :: GenParser Char st String +type_parser = do + _ <- string "!Type:" + typeinfo <- manyTill (noneOf ['\n', '\r']) newline_or_eof + return typeinfo + +-- | Parser for a qif file +qif_file_parser :: GenParser Char st Qif +qif_file_parser = do + typeinfo <- type_parser + transactions <- transactions_parser + return Qif {typeinfo = typeinfo, transactions = transactions} + +-- | obtain qif from string +qifFromString s = + fromRight (Qif {typeinfo = "Bank", transactions = []}) $ + parse qif_file_parser "(unknown)" s + +-- | IO Monad helper function: reads and parses qif file +-- * if parsing successful returns qif data structure, otherwise returns "empty" qif +parse_qif_file filename = do + contents <- readFile filename + return $ qifFromString contents + +{- ************************************************** + Helper functions +*************************************************** -} +-- | test out parser on string +-- test_parser p s = parse p "(unknown)" s +-- | parses newline but throws away '\n' +newline_skip = do + _ <- newline + return () + +-- | skips newline but also succeeds at end-of-file +newline_or_eof = choice [newline_skip, eof] + +-- | quick and dirty Either exception handling with default value +fromRight d (Right x) = x +fromRight d _ = d diff --git a/test/Tester.hs b/test/Tester.hs deleted file mode 100644 --- a/test/Tester.hs +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------ --- --- Module : Tester --- Copyright : (c) Ingolf Wagner --- License : BSD3 --- --- Maintainer : Ingolf Wagner --- Stability : unstable --- Portability : --- --- | --- ------------------------------------------------------------------------------ - -module Main (main) where - - -import Test.Hspec -import Qifer - -main :: IO () -main = hspec $ do - describe "Csv" $ do - it "should transform CSV" $ do - let rule = (Rule 1 [2] [0,3] 4) - trans= (Transaction "2" "3" "1 4" "5") - csv = [["1","2","3","4","5"]] - (toTransactions rule csv) `shouldBe` [trans] - it "should generate Qif" $ do - let trans = (Transaction "heute" "short" "long bla bla" "100$") - qif = ["Pshort","T100$","Dheute","Mlong bla bla"] - (toQif trans) `shouldBe` qif - it "should generate Qif File content" $ do - let trans = (Transaction "heute" "short" "long bla bla" "100$") - qif = ["!Type:Bank","Pshort","T100$","Dheute","Mlong bla bla","^"] - (transToQif [trans]) `shouldBe` qif - it "should update a transaction" $ do - let trans = (Transaction "heute" "short" "long bla bla" "100$") - theUpdate = (Transaction "heute" "bam" "long bla bla" "100$") - (updateTransaction "ort" "bam" trans) `shouldBe` theUpdate - (updateTransaction "foo" "bam" trans) `shouldBe` trans - it "should update multiple transactions" $ do - let transA = (Transaction "heute" "short story long its .." "long bla bla" "100$") - transB = (Transaction "morgen" "balla ball bam bam boom" "long bla bla" "100$") - transA1 = (Transaction "heute" "found story" "long bla bla" "100$") - transB1 = (Transaction "morgen" "found balla" "long bla bla" "100$") - regex = [("story","found story"),("balla","found balla")] - transactions = [transA,transB] - (update regex transactions) `shouldBe` [transA1,transB1] - -