slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

csv: refactor (#548)

Browse Source
This commit is contained in:
Simon Michael 2017-05-14 18:17:56 +09:00
parent 309d1ccd59
commit 5e00d2f31c
1 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -35,7 +35,6 @@ import Control.Monad.Except
import Control.Monad.State.Strict (StateT, get, modify', evalStateT) import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
-- import Test.HUnit -- import Test.HUnit
import Data.Char (toLower, isDigit, isSpace) import Data.Char (toLower, isDigit, isSpace)
import Data.List (findIndices)
import Data.List.Compat import Data.List.Compat
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
@ -642,7 +641,7 @@ transactionFromCsvRecord sourcepos rules record = t
comment = maybe "" render $ mfieldtemplate "comment" comment = maybe "" render $ mfieldtemplate "comment"
precomment = maybe "" render $ mfieldtemplate "precomment" precomment = maybe "" render $ mfieldtemplate "precomment"
currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency"
amountstr = (currency++) $ simplifySign $ negateIfParenthesised $ getAmountStr rules record amountstr = (currency++) $ simplifySign $ getAmountStr rules record
amount = either amounterror (Mixed . (:[])) $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack amountstr amount = either amounterror (Mixed . (:[])) $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack amountstr
amounterror err = error' $ unlines amounterror err = error' $ unlines
["error: could not parse \""++amountstr++"\" as an amount" ["error: could not parse \""++amountstr++"\" as an amount"
@ -669,7 +668,7 @@ transactionFromCsvRecord sourcepos rules record = t
balance = maybe Nothing (parsebalance.render) $ mfieldtemplate "balance" balance = maybe Nothing (parsebalance.render) $ mfieldtemplate "balance"
parsebalance str parsebalance str
| all isSpace str = Nothing | all isSpace str = Nothing
| otherwise = Just $ either (balanceerror str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ negateIfParenthesised str | otherwise = Just $ either (balanceerror str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ simplifySign str
balanceerror str err = error' $ unlines balanceerror str err = error' $ unlines
["error: could not parse \""++str++"\" as balance amount" ["error: could not parse \""++str++"\" as balance amount"
,showRecord record ,showRecord record
@ -712,21 +711,15 @@ getAmountStr rules record =
(Nothing, Just _, Just _) -> error' $ "both amount-in and amount-out have a value\n"++showRecord record (Nothing, Just _, Just _) -> error' $ "both amount-in and amount-out have a value\n"++showRecord record
_ -> error' $ "found values for amount and for amount-in/amount-out - please use either amount or amount-in/amount-out\n"++showRecord record _ -> error' $ "found values for amount and for amount-in/amount-out - please use either amount or amount-in/amount-out\n"++showRecord record
-- From a String representing an Amount, simplify the sign by type CsvAmountString = String
-- removing '-' by pair from the left. It happens that some amount
-- strings contain 2 '-' because of CSV reading rules
simplifySign :: String -> String
simplifySign amount
| length indices < 2 = amount
| otherwise = simplifySign $ simplify2 amount
where
indices = findIndices (== '-') amount
simplify = delete '-'
simplify2 = simplify . simplify
negateIfParenthesised :: String -> String -- | Canonicalise the sign in a CSV amount string.
negateIfParenthesised ('(':s) | lastMay s == Just ')' = negateStr $ init s -- Such strings can be parenthesized, which is equivalent to having a minus sign.
negateIfParenthesised s = s -- Also they can end up with a double minus sign, which cancels out.
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s
simplifySign ('-':'-':s) = s
simplifySign s = s
negateStr :: String -> String negateStr :: String -> String
negateStr ('-':s) = s negateStr ('-':s) = s