mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 20:02:27 +03:00
Hlint: Error: Redundant $
This commit is contained in:
parent
550357934f
commit
8fdd28d446
@ -45,7 +45,7 @@ getTransaction l args = do
|
|||||||
datestr <- askFor "date"
|
datestr <- askFor "date"
|
||||||
(Just $ showDate today)
|
(Just $ showDate today)
|
||||||
(Just $ \s -> null s ||
|
(Just $ \s -> null s ||
|
||||||
(isRight $ parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
|
isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
|
||||||
description <- if null args
|
description <- if null args
|
||||||
then askFor "description" Nothing (Just $ not . null)
|
then askFor "description" Nothing (Just $ not . null)
|
||||||
else do
|
else do
|
||||||
@ -54,7 +54,7 @@ getTransaction l args = do
|
|||||||
return description
|
return description
|
||||||
let historymatches = transactionsSimilarTo l description
|
let historymatches = transactionsSimilarTo l description
|
||||||
bestmatch | null historymatches = Nothing
|
bestmatch | null historymatches = Nothing
|
||||||
| otherwise = Just $ snd $ head $ historymatches
|
| otherwise = Just $ snd $ head historymatches
|
||||||
bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch
|
bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch
|
||||||
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
|
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
|
||||||
getpostingsandvalidate = do
|
getpostingsandvalidate = do
|
||||||
@ -103,8 +103,8 @@ getPostings historicalps enteredps = do
|
|||||||
postingtype ('(':_) = VirtualPosting
|
postingtype ('(':_) = VirtualPosting
|
||||||
postingtype _ = RegularPosting
|
postingtype _ = RegularPosting
|
||||||
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
|
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
|
||||||
validateamount = Just $ \s -> (null s && (not $ null enteredrealps))
|
validateamount = Just $ \s -> (null s && not (null enteredrealps))
|
||||||
|| (isRight $ parse (someamount>>many spacenonewline>>eof) "" s)
|
|| isRight (parse (someamount>>many spacenonewline>>eof) "" s)
|
||||||
|
|
||||||
-- | Prompt for and read a string value, optionally with a default value
|
-- | Prompt for and read a string value, optionally with a default value
|
||||||
-- and a validator. A validator causes the prompt to repeat until the
|
-- and a validator. A validator causes the prompt to repeat until the
|
||||||
@ -185,7 +185,7 @@ transactionsSimilarTo :: Ledger -> String -> [(Double,LedgerTransaction)]
|
|||||||
transactionsSimilarTo l s =
|
transactionsSimilarTo l s =
|
||||||
sortBy compareRelevanceAndRecency
|
sortBy compareRelevanceAndRecency
|
||||||
$ filter ((> threshold).fst)
|
$ filter ((> threshold).fst)
|
||||||
$ [(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts]
|
[(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts]
|
||||||
where
|
where
|
||||||
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1)
|
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1)
|
||||||
ts = ledger_txns $ rawledger l
|
ts = ledger_txns $ rawledger l
|
||||||
|
@ -138,7 +138,7 @@ showInterestingAccount l interestingaccts a = concatTopPadded [amt, " ", depths
|
|||||||
depthspacer = replicate (2 * length interestingparents) ' '
|
depthspacer = replicate (2 * length interestingparents) ' '
|
||||||
-- the partial name is the account's leaf name, prefixed by the
|
-- the partial name is the account's leaf name, prefixed by the
|
||||||
-- names of any boring parents immediately above
|
-- names of any boring parents immediately above
|
||||||
partialname = accountNameFromComponents $ (reverse $ map accountLeafName ps) ++ [accountLeafName a]
|
partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
|
||||||
where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
|
where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
|
||||||
|
|
||||||
-- | Is the named account considered interesting for this ledger's balance report ?
|
-- | Is the named account considered interesting for this ledger's balance report ?
|
||||||
|
@ -35,7 +35,7 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns
|
|||||||
| otherwise = filter (not . isZeroMixedAmount . tamount)
|
| otherwise = filter (not . isZeroMixedAmount . tamount)
|
||||||
matchapats = matchpats apats . taccount
|
matchapats = matchpats apats . taccount
|
||||||
(apats,_) = parsePatternArgs args
|
(apats,_) = parsePatternArgs args
|
||||||
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
|
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth)
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
depth = depthFromOpts opts
|
depth = depthFromOpts opts
|
||||||
|
|
||||||
|
@ -34,7 +34,7 @@ showRegisterReport opts args l
|
|||||||
where
|
where
|
||||||
interval = intervalFromOpts opts
|
interval = intervalFromOpts opts
|
||||||
ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
||||||
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
|
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth)
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
filterempties
|
filterempties
|
||||||
| Empty `elem` opts = id
|
| Empty `elem` opts = id
|
||||||
@ -75,7 +75,7 @@ summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts
|
|||||||
| null ts = []
|
| null ts = []
|
||||||
| otherwise = summaryts'
|
| otherwise = summaryts'
|
||||||
where
|
where
|
||||||
txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++(showDate $ addDays (-1) e')}
|
txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++ showDate (addDays (-1) e')}
|
||||||
b' = fromMaybe (tdate $ head ts) b
|
b' = fromMaybe (tdate $ head ts) b
|
||||||
e' = fromMaybe (tdate $ last ts) e
|
e' = fromMaybe (tdate $ last ts) e
|
||||||
summaryts'
|
summaryts'
|
||||||
@ -108,7 +108,7 @@ showtxn :: Bool -> Transaction -> MixedAmount -> String
|
|||||||
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
|
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
|
||||||
where
|
where
|
||||||
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc
|
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc
|
||||||
date = showDate $ da
|
date = showDate da
|
||||||
desc = printf "%-20s" $ elideRight 20 de :: String
|
desc = printf "%-20s" $ elideRight 20 de :: String
|
||||||
p = showPosting $ Posting s a amt "" tt
|
p = showPosting $ Posting s a amt "" tt
|
||||||
bal = padleft 12 (showMixedAmountOrZero b)
|
bal = padleft 12 (showMixedAmountOrZero b)
|
||||||
|
@ -20,7 +20,7 @@ stats opts args l = do
|
|||||||
|
|
||||||
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
|
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
|
||||||
showStats _ _ l today =
|
showStats _ _ l today =
|
||||||
heading ++ (unlines $ map (\(a,b) -> printf fmt a b) stats)
|
heading ++ unlines (map (\(a,b) -> printf fmt a b) stats)
|
||||||
where
|
where
|
||||||
heading = underline $ printf "Ledger statistics as of %s" (show today)
|
heading = underline $ printf "Ledger statistics as of %s" (show today)
|
||||||
fmt = "%-" ++ (show w1) ++ "s: %-" ++ (show w2) ++ "s"
|
fmt = "%-" ++ (show w1) ++ "s: %-" ++ (show w2) ++ "s"
|
||||||
|
@ -52,7 +52,7 @@ ui opts args l = do
|
|||||||
v <- mkVty
|
v <- mkVty
|
||||||
DisplayBounds w h <- display_bounds $ terminal v
|
DisplayBounds w h <- display_bounds $ terminal v
|
||||||
let opts' = SubTotal:opts
|
let opts' = SubTotal:opts
|
||||||
let a = enter BalanceScreen $
|
let a = enter BalanceScreen
|
||||||
AppState {
|
AppState {
|
||||||
av=v
|
av=v
|
||||||
,aw=fromIntegral w
|
,aw=fromIntegral w
|
||||||
@ -269,7 +269,7 @@ accountNameAt buf lineno = accountNameFromComponents anamecomponents
|
|||||||
scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState
|
scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState
|
||||||
scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
|
scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
|
||||||
where
|
where
|
||||||
entryfirstline = head $ lines $ showLedgerTransaction $ e
|
entryfirstline = head $ lines $ showLedgerTransaction e
|
||||||
halfph = pageHeight a `div` 2
|
halfph = pageHeight a `div` 2
|
||||||
y = fromMaybe 0 $ findIndex (== entryfirstline) buf
|
y = fromMaybe 0 $ findIndex (== entryfirstline) buf
|
||||||
sy = max 0 $ y - halfph
|
sy = max 0 $ y - halfph
|
||||||
@ -282,8 +282,8 @@ currentLedgerTransaction :: AppState -> LedgerTransaction
|
|||||||
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
|
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
|
||||||
where
|
where
|
||||||
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
|
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
|
||||||
ismatch t = tdate t == (parsedate $ take 10 datedesc)
|
ismatch t = tdate t == parsedate (take 10 datedesc)
|
||||||
&& (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt)
|
&& take 70 (showtxn False t nullmixedamt) == (datedesc ++ acctamt)
|
||||||
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above
|
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above
|
||||||
acctamt = drop 32 $ safehead "" rest
|
acctamt = drop 32 $ safehead "" rest
|
||||||
safehead d ls = if null ls then d else head ls
|
safehead d ls = if null ls then d else head ls
|
||||||
@ -293,7 +293,7 @@ currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransac
|
|||||||
-- | Get the entry which contains the given transaction.
|
-- | Get the entry which contains the given transaction.
|
||||||
-- Will raise an error if there are problems.
|
-- Will raise an error if there are problems.
|
||||||
entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction
|
entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction
|
||||||
entryContainingTransaction AppState{aledger=l} t = (ledger_txns $ rawledger l) !! tnum t
|
entryContainingTransaction AppState{aledger=l} t = ledger_txns (rawledger l) !! tnum t
|
||||||
|
|
||||||
-- renderers
|
-- renderers
|
||||||
|
|
||||||
@ -309,11 +309,11 @@ renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =
|
|||||||
(cx, cy) = (0, cursorY a)
|
(cx, cy) = (0, cursorY a)
|
||||||
sy = scrollY a
|
sy = scrollY a
|
||||||
-- trying for more speed
|
-- trying for more speed
|
||||||
mainimg = (vert_cat $ map (string defaultattr) above)
|
mainimg = vert_cat (map (string defaultattr) above)
|
||||||
<->
|
<->
|
||||||
(string currentlineattr thisline)
|
(string currentlineattr thisline)
|
||||||
<->
|
<->
|
||||||
(vert_cat $ map (string defaultattr) below)
|
vert_cat (map (string defaultattr) below)
|
||||||
(thisline,below) | null rest = (blankline,[])
|
(thisline,below) | null rest = (blankline,[])
|
||||||
| otherwise = (head rest, tail rest)
|
| otherwise = (head rest, tail rest)
|
||||||
(above,rest) = splitAt cy linestorender
|
(above,rest) = splitAt cy linestorender
|
||||||
@ -341,7 +341,7 @@ renderString :: Attr -> String -> Image
|
|||||||
renderString attr s = vert_cat $ map (string attr) rows
|
renderString attr s = vert_cat $ map (string attr) rows
|
||||||
where
|
where
|
||||||
rows = lines $ fitto w h s
|
rows = lines $ fitto w h s
|
||||||
w = maximum $ map length $ ls
|
w = maximum $ map length ls
|
||||||
h = length ls
|
h = length ls
|
||||||
ls = lines s
|
ls = lines s
|
||||||
|
|
||||||
|
@ -29,7 +29,7 @@ accountLeafName = last . accountNameComponents
|
|||||||
|
|
||||||
accountNameLevel :: AccountName -> Int
|
accountNameLevel :: AccountName -> Int
|
||||||
accountNameLevel "" = 0
|
accountNameLevel "" = 0
|
||||||
accountNameLevel a = (length $ filter (==acctsepchar) a) + 1
|
accountNameLevel a = length (filter (==acctsepchar) a) + 1
|
||||||
|
|
||||||
-- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
|
-- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
|
||||||
expandAccountNames :: [AccountName] -> [AccountName]
|
expandAccountNames :: [AccountName] -> [AccountName]
|
||||||
@ -47,7 +47,7 @@ parentAccountNames :: AccountName -> [AccountName]
|
|||||||
parentAccountNames a = parentAccountNames' $ parentAccountName a
|
parentAccountNames a = parentAccountNames' $ parentAccountName a
|
||||||
where
|
where
|
||||||
parentAccountNames' "" = []
|
parentAccountNames' "" = []
|
||||||
parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a)
|
parentAccountNames' a = [a] ++ parentAccountNames' (parentAccountName a)
|
||||||
|
|
||||||
isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
|
isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
|
||||||
isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar])
|
isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar])
|
||||||
@ -160,7 +160,7 @@ elideAccountName width s =
|
|||||||
where
|
where
|
||||||
elideparts :: Int -> [String] -> [String] -> [String]
|
elideparts :: Int -> [String] -> [String] -> [String]
|
||||||
elideparts width done ss
|
elideparts width done ss
|
||||||
| (length $ accountNameFromComponents $ done++ss) <= width = done++ss
|
| length (accountNameFromComponents $ done++ss) <= width = done++ss
|
||||||
| length ss > 1 = elideparts width (done++[take 2 $ head ss]) (tail ss)
|
| length ss > 1 = elideparts width (done++[take 2 $ head ss]) (tail ss)
|
||||||
| otherwise = done++ss
|
| otherwise = done++ss
|
||||||
|
|
||||||
|
@ -77,7 +77,7 @@ negateAmountPreservingPrice a = (-a){price=price a}
|
|||||||
-- and other folds start with a no-commodity amount.)
|
-- and other folds start with a no-commodity amount.)
|
||||||
amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
|
amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
|
||||||
amountop op a@(Amount _ _ _) (Amount bc bq _) =
|
amountop op a@(Amount _ _ _) (Amount bc bq _) =
|
||||||
Amount bc ((quantity $ convertAmountTo bc a) `op` bq) Nothing
|
Amount bc (quantity (convertAmountTo bc a) `op` bq) Nothing
|
||||||
|
|
||||||
-- | Convert an amount to the commodity of its saved price, if any.
|
-- | Convert an amount to the commodity of its saved price, if any.
|
||||||
costOfAmount :: Amount -> Amount
|
costOfAmount :: Amount -> Amount
|
||||||
@ -122,7 +122,7 @@ punctuatethousands s =
|
|||||||
(int,frac) = break (=='.') num
|
(int,frac) = break (=='.') num
|
||||||
addcommas = reverse . concat . intersperse "," . triples . reverse
|
addcommas = reverse . concat . intersperse "," . triples . reverse
|
||||||
triples [] = []
|
triples [] = []
|
||||||
triples l = [take 3 l] ++ (triples $ drop 3 l)
|
triples l = [take 3 l] ++ triples (drop 3 l)
|
||||||
|
|
||||||
-- | Does this amount appear to be zero when displayed with its given precision ?
|
-- | Does this amount appear to be zero when displayed with its given precision ?
|
||||||
isZeroAmount :: Amount -> Bool
|
isZeroAmount :: Amount -> Bool
|
||||||
@ -162,7 +162,7 @@ showMixedAmount :: MixedAmount -> String
|
|||||||
showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as
|
showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as
|
||||||
where
|
where
|
||||||
(Mixed as) = normaliseMixedAmount m
|
(Mixed as) = normaliseMixedAmount m
|
||||||
width = maximum $ map (length . show) $ as
|
width = maximum $ map (length . show) as
|
||||||
showfixedwidth = printf (printf "%%%ds" width) . show
|
showfixedwidth = printf (printf "%%%ds" width) . show
|
||||||
|
|
||||||
-- | Get the string representation of a mixed amount, and if it
|
-- | Get the string representation of a mixed amount, and if it
|
||||||
|
@ -242,7 +242,7 @@ smartdate = do
|
|||||||
lastthisnextthing
|
lastthisnextthing
|
||||||
]
|
]
|
||||||
(y,m,d) <- choice $ map try dateparsers
|
(y,m,d) <- choice $ map try dateparsers
|
||||||
return $ (y,m,d)
|
return (y,m,d)
|
||||||
|
|
||||||
datesepchar = oneOf "/-."
|
datesepchar = oneOf "/-."
|
||||||
|
|
||||||
@ -310,7 +310,7 @@ month :: GenParser Char st SmartDate
|
|||||||
month = do
|
month = do
|
||||||
m <- choice $ map (try . string) months
|
m <- choice $ map (try . string) months
|
||||||
let i = monthIndex m
|
let i = monthIndex m
|
||||||
return $ ("",show i,"")
|
return ("",show i,"")
|
||||||
|
|
||||||
mon :: GenParser Char st SmartDate
|
mon :: GenParser Char st SmartDate
|
||||||
mon = do
|
mon = do
|
||||||
@ -331,7 +331,7 @@ lastthisnextthing = do
|
|||||||
,string "next"
|
,string "next"
|
||||||
]
|
]
|
||||||
many spacenonewline -- make the space optional for easier scripting
|
many spacenonewline -- make the space optional for easier scripting
|
||||||
p <- choice $ [
|
p <- choice [
|
||||||
string "day"
|
string "day"
|
||||||
,string "week"
|
,string "week"
|
||||||
,string "month"
|
,string "month"
|
||||||
@ -348,7 +348,7 @@ periodexpr rdate = choice $ map try [
|
|||||||
intervalanddateperiodexpr rdate,
|
intervalanddateperiodexpr rdate,
|
||||||
intervalperiodexpr,
|
intervalperiodexpr,
|
||||||
dateperiodexpr rdate,
|
dateperiodexpr rdate,
|
||||||
(return $ (NoInterval,DateSpan Nothing Nothing))
|
(return (NoInterval,DateSpan Nothing Nothing))
|
||||||
]
|
]
|
||||||
|
|
||||||
intervalanddateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)
|
intervalanddateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)
|
||||||
|
@ -65,9 +65,9 @@ import Ledger.RawLedger
|
|||||||
|
|
||||||
instance Show Ledger where
|
instance Show Ledger where
|
||||||
show l = printf "Ledger with %d transactions, %d accounts\n%s"
|
show l = printf "Ledger with %d transactions, %d accounts\n%s"
|
||||||
((length $ ledger_txns $ rawledger l) +
|
(length (ledger_txns $ rawledger l) +
|
||||||
(length $ modifier_txns $ rawledger l) +
|
length (modifier_txns $ rawledger l) +
|
||||||
(length $ periodic_txns $ rawledger l))
|
length (periodic_txns $ rawledger l))
|
||||||
(length $ accountnames l)
|
(length $ accountnames l)
|
||||||
(showtree $ accountnametree l)
|
(showtree $ accountnametree l)
|
||||||
|
|
||||||
@ -91,7 +91,7 @@ groupTransactions :: [Transaction] -> (Tree AccountName,
|
|||||||
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
|
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
|
||||||
where
|
where
|
||||||
txnanames = sort $ nub $ map taccount ts
|
txnanames = sort $ nub $ map taccount ts
|
||||||
ant = accountNameTreeFrom $ expandAccountNames $ txnanames
|
ant = accountNameTreeFrom $ expandAccountNames txnanames
|
||||||
allanames = flatten ant
|
allanames = flatten ant
|
||||||
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
|
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
|
||||||
balmap = Map.fromList $ flatten $ calculateBalances ant txnsof
|
balmap = Map.fromList $ flatten $ calculateBalances ant txnsof
|
||||||
|
@ -61,13 +61,13 @@ showLedgerTransactionForPrint effective = showLedgerTransaction' False effective
|
|||||||
|
|
||||||
showLedgerTransaction' :: Bool -> Bool -> LedgerTransaction -> String
|
showLedgerTransaction' :: Bool -> Bool -> LedgerTransaction -> String
|
||||||
showLedgerTransaction' elide effective t =
|
showLedgerTransaction' elide effective t =
|
||||||
unlines $ [description] ++ (showpostings $ ltpostings t) ++ [""]
|
unlines $ [description] ++ showpostings (ltpostings t) ++ [""]
|
||||||
where
|
where
|
||||||
description = concat [date, status, code, desc] -- , comment]
|
description = concat [date, status, code, desc] -- , comment]
|
||||||
date | effective = showdate $ fromMaybe (ltdate t) $ lteffectivedate t
|
date | effective = showdate $ fromMaybe (ltdate t) $ lteffectivedate t
|
||||||
| otherwise = showdate (ltdate t) ++ maybe "" showedate (lteffectivedate t)
|
| otherwise = showdate (ltdate t) ++ maybe "" showedate (lteffectivedate t)
|
||||||
status = if ltstatus t then " *" else ""
|
status = if ltstatus t then " *" else ""
|
||||||
code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
|
code = if length (ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
|
||||||
desc = " " ++ ltdescription t
|
desc = " " ++ ltdescription t
|
||||||
showdate = printf "%-10s" . showDate
|
showdate = printf "%-10s" . showDate
|
||||||
showedate = printf "=%s" . showdate
|
showedate = printf "=%s" . showdate
|
||||||
@ -76,9 +76,9 @@ showLedgerTransaction' elide effective t =
|
|||||||
= map showposting (init ps) ++ [showpostingnoamt (last ps)]
|
= map showposting (init ps) ++ [showpostingnoamt (last ps)]
|
||||||
| otherwise = map showposting ps
|
| otherwise = map showposting ps
|
||||||
where
|
where
|
||||||
showposting p = showacct p ++ " " ++ (showamount $ pamount p) ++ (showcomment $ pcomment p)
|
showposting p = showacct p ++ " " ++ showamount (pamount p) ++ showcomment (pcomment p)
|
||||||
showpostingnoamt p = rstrip $ showacct p ++ " " ++ (showcomment $ pcomment p)
|
showpostingnoamt p = rstrip $ showacct p ++ " " ++ showcomment (pcomment p)
|
||||||
showacct p = " " ++ showstatus p ++ (printf (printf "%%-%ds" w) $ showAccountName Nothing (ptype p) (paccount p))
|
showacct p = " " ++ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))
|
||||||
w = maximum $ map (length . paccount) ps
|
w = maximum $ map (length . paccount) ps
|
||||||
showamount = printf "%12s" . showMixedAmount
|
showamount = printf "%12s" . showMixedAmount
|
||||||
showcomment s = if (length s) > 0 then " ; "++s else ""
|
showcomment s = if (length s) > 0 then " ; "++s else ""
|
||||||
|
@ -115,7 +115,7 @@ ledgerInclude = do many1 spacenonewline
|
|||||||
case runParser ledgerFile outerState filename contents of
|
case runParser ledgerFile outerState filename contents of
|
||||||
Right l -> l `catchError` (throwError . (inIncluded ++))
|
Right l -> l `catchError` (throwError . (inIncluded ++))
|
||||||
Left perr -> throwError $ inIncluded ++ show perr
|
Left perr -> throwError $ inIncluded ++ show perr
|
||||||
where readFileE outerPos filename = ErrorT $ do (liftM Right $ readFile filename) `catch` leftError
|
where readFileE outerPos filename = ErrorT $ do liftM Right (readFile filename) `catch` leftError
|
||||||
where leftError err = return $ Left $ currentPos ++ whileReading ++ show err
|
where leftError err = return $ Left $ currentPos ++ whileReading ++ show err
|
||||||
currentPos = show outerPos
|
currentPos = show outerPos
|
||||||
whileReading = " reading " ++ show filename ++ ":\n"
|
whileReading = " reading " ++ show filename ++ ":\n"
|
||||||
|
@ -21,9 +21,9 @@ import Ledger.TimeLog
|
|||||||
|
|
||||||
instance Show RawLedger where
|
instance Show RawLedger where
|
||||||
show l = printf "RawLedger with %d transactions, %d accounts: %s"
|
show l = printf "RawLedger with %d transactions, %d accounts: %s"
|
||||||
((length $ ledger_txns l) +
|
(length (ledger_txns l) +
|
||||||
(length $ modifier_txns l) +
|
length (modifier_txns l) +
|
||||||
(length $ periodic_txns l))
|
length (periodic_txns l))
|
||||||
(length accounts)
|
(length accounts)
|
||||||
(show accounts)
|
(show accounts)
|
||||||
-- ++ (show $ rawLedgerTransactions l)
|
-- ++ (show $ rawLedgerTransactions l)
|
||||||
@ -139,7 +139,7 @@ canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms
|
|||||||
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
|
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
|
||||||
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
||||||
fixamount = fixcommodity . (if costbasis then costOfAmount else id)
|
fixamount = fixcommodity . (if costbasis then costOfAmount else id)
|
||||||
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)
|
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! symbol (commodity a)
|
||||||
canonicalcommoditymap =
|
canonicalcommoditymap =
|
||||||
Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
|
Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
|
||||||
let cs = commoditymap ! s,
|
let cs = commoditymap ! s,
|
||||||
|
@ -55,7 +55,7 @@ dropws = dropWhile (`elem` " \t")
|
|||||||
|
|
||||||
elideLeft width s =
|
elideLeft width s =
|
||||||
case length s > width of
|
case length s > width of
|
||||||
True -> ".." ++ (reverse $ take (width - 2) $ reverse s)
|
True -> ".." ++ reverse (take (width - 2) $ reverse s)
|
||||||
False -> s
|
False -> s
|
||||||
|
|
||||||
elideRight width s =
|
elideRight width s =
|
||||||
@ -206,7 +206,7 @@ treefilter f t = Node
|
|||||||
|
|
||||||
-- | is predicate true in any node of tree ?
|
-- | is predicate true in any node of tree ?
|
||||||
treeany :: (a -> Bool) -> Tree a -> Bool
|
treeany :: (a -> Bool) -> Tree a -> Bool
|
||||||
treeany f t = (f $ root t) || (any (treeany f) $ branches t)
|
treeany f t = f (root t) || any (treeany f) (branches t)
|
||||||
|
|
||||||
-- treedrop -- remove the leaves which do fulfill predicate.
|
-- treedrop -- remove the leaves which do fulfill predicate.
|
||||||
-- treedropall -- do this repeatedly.
|
-- treedropall -- do this repeatedly.
|
||||||
|
@ -150,7 +150,7 @@ fixOptDates opts = do
|
|||||||
fixopt d (End s) = End $ fixSmartDateStr d s
|
fixopt d (End s) = End $ fixSmartDateStr d s
|
||||||
fixopt d (Display s) = -- hacky
|
fixopt d (Display s) = -- hacky
|
||||||
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
||||||
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr d $ init $ tail s) ++ "]"
|
where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
||||||
fixopt _ o = o
|
fixopt _ o = o
|
||||||
|
|
||||||
-- | Figure out the overall date span we should report on, based on any
|
-- | Figure out the overall date span we should report on, based on any
|
||||||
|
20
Tests.hs
20
Tests.hs
@ -488,11 +488,11 @@ tests = [
|
|||||||
Left _ -> error "should not happen")
|
Left _ -> error "should not happen")
|
||||||
|
|
||||||
,"cacheLedger" ~: do
|
,"cacheLedger" ~: do
|
||||||
(length $ Map.keys $ accountmap $ cacheLedger [] rawledger7) `is` 15
|
length (Map.keys $ accountmap $ cacheLedger [] rawledger7) `is` 15
|
||||||
|
|
||||||
,"canonicaliseAmounts" ~:
|
,"canonicaliseAmounts" ~:
|
||||||
"use the greatest precision" ~: do
|
"use the greatest precision" ~: do
|
||||||
(rawLedgerPrecisions $ canonicaliseAmounts False $ rawLedgerWithAmounts ["1","2.00"]) `is` [2,2]
|
rawLedgerPrecisions (canonicaliseAmounts False $ rawLedgerWithAmounts ["1","2.00"]) `is` [2,2]
|
||||||
|
|
||||||
,"commodities" ~: do
|
,"commodities" ~: do
|
||||||
commodities ledger7 `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]
|
commodities ledger7 `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]
|
||||||
@ -615,11 +615,11 @@ tests = [
|
|||||||
|
|
||||||
,"default year" ~: do
|
,"default year" ~: do
|
||||||
rl <- rawLedgerFromString defaultyear_ledger_str
|
rl <- rawLedgerFromString defaultyear_ledger_str
|
||||||
(ltdate $ head $ ledger_txns rl) `is` fromGregorian 2009 1 1
|
ltdate (head $ ledger_txns rl) `is` fromGregorian 2009 1 1
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
,"ledgerFile" ~: do
|
,"ledgerFile" ~: do
|
||||||
assertBool "ledgerFile should parse an empty file" $ (isRight $ parseWithCtx emptyCtx ledgerFile "")
|
assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")
|
||||||
r <- rawLedgerFromString "" -- don't know how to get it from ledgerFile
|
r <- rawLedgerFromString "" -- don't know how to get it from ledgerFile
|
||||||
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r
|
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r
|
||||||
|
|
||||||
@ -637,10 +637,10 @@ tests = [
|
|||||||
$ either (const False) ((== "a") . ltdescription) t
|
$ either (const False) ((== "a") . ltdescription) t
|
||||||
|
|
||||||
,"ledgeraccountname" ~: do
|
,"ledgeraccountname" ~: do
|
||||||
assertBool "ledgeraccountname parses a normal accountname" $ (isRight $ parsewith ledgeraccountname "a:b:c")
|
assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")
|
||||||
assertBool "ledgeraccountname rejects an empty inner component" $ (isLeft $ parsewith ledgeraccountname "a::c")
|
assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c")
|
||||||
assertBool "ledgeraccountname rejects an empty leading component" $ (isLeft $ parsewith ledgeraccountname ":b:c")
|
assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c")
|
||||||
assertBool "ledgeraccountname rejects an empty trailing component" $ (isLeft $ parsewith ledgeraccountname "a:b:")
|
assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")
|
||||||
|
|
||||||
,"ledgerposting" ~: do
|
,"ledgerposting" ~: do
|
||||||
parseWithCtx emptyCtx ledgerposting rawposting1_str `parseis` rawposting1
|
parseWithCtx emptyCtx ledgerposting rawposting1_str `parseis` rawposting1
|
||||||
@ -651,7 +651,7 @@ tests = [
|
|||||||
|
|
||||||
,"period expressions" ~: do
|
,"period expressions" ~: do
|
||||||
let todaysdate = parsedate "2008/11/26"
|
let todaysdate = parsedate "2008/11/26"
|
||||||
let str `gives` result = (show $ parsewith (periodexpr todaysdate) str) `is` ("Right "++result)
|
let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result)
|
||||||
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
||||||
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
||||||
"every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
"every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
||||||
@ -943,7 +943,7 @@ tests = [
|
|||||||
,"subAccounts" ~: do
|
,"subAccounts" ~: do
|
||||||
l <- sampleledger
|
l <- sampleledger
|
||||||
let a = ledgerAccount l "assets"
|
let a = ledgerAccount l "assets"
|
||||||
(map aname $ ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
|
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
|
||||||
|
|
||||||
,"summariseTransactionsInDateSpan" ~: do
|
,"summariseTransactionsInDateSpan" ~: do
|
||||||
let gives (b,e,tnum,depth,showempty,ts) =
|
let gives (b,e,tnum,depth,showempty,ts) =
|
||||||
|
@ -52,7 +52,7 @@ main = do
|
|||||||
run cmd opts args
|
run cmd opts args
|
||||||
where
|
where
|
||||||
run cmd opts args
|
run cmd opts args
|
||||||
| Help `elem` opts = putStr $ usage
|
| Help `elem` opts = putStr usage
|
||||||
| Version `elem` opts = putStrLn versionmsg
|
| Version `elem` opts = putStrLn versionmsg
|
||||||
| BinaryFilename `elem` opts = putStrLn binaryfilename
|
| BinaryFilename `elem` opts = putStrLn binaryfilename
|
||||||
| cmd `isPrefixOf` "balance" = withLedgerDo opts args cmd balance
|
| cmd `isPrefixOf` "balance" = withLedgerDo opts args cmd balance
|
||||||
@ -69,4 +69,4 @@ main = do
|
|||||||
| cmd `isPrefixOf` "web" = withLedgerDo opts args cmd web
|
| cmd `isPrefixOf` "web" = withLedgerDo opts args cmd web
|
||||||
#endif
|
#endif
|
||||||
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
|
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
|
||||||
| otherwise = putStr $ usage
|
| otherwise = putStr usage
|
||||||
|
@ -175,6 +175,6 @@ maketable opts rownames colnames results = Table rowhdrs colhdrs rows
|
|||||||
where w = maximum $ map length ss
|
where w = maximum $ map length ss
|
||||||
|
|
||||||
showtime :: [Opt] -> (Float -> String)
|
showtime :: [Opt] -> (Float -> String)
|
||||||
showtime opts = printf $ "%."++(show $ precisionopt opts)++"f"
|
showtime opts = printf $ "%." ++ show (precisionopt opts) ++ "f"
|
||||||
|
|
||||||
strace a = trace (show a) a
|
strace a = trace (show a) a
|
||||||
|
@ -45,7 +45,7 @@ uniqueacctnames' depth uniquenames = group some ++ uniqueacctnames' depth rest
|
|||||||
-- group ["a", "b", "c"] = ["a","a:b","a:b:c"]
|
-- group ["a", "b", "c"] = ["a","a:b","a:b:c"]
|
||||||
group :: [String] -> [String]
|
group :: [String] -> [String]
|
||||||
group [] = []
|
group [] = []
|
||||||
group (a:as) = [a] ++ (map ((a++":")++) $ group as)
|
group (a:as) = [a] ++ map ((a++":")++) (group as)
|
||||||
|
|
||||||
pair :: [a] -> [(a,a)]
|
pair :: [a] -> [(a,a)]
|
||||||
pair [] = []
|
pair [] = []
|
||||||
|
@ -15,7 +15,7 @@ main = do
|
|||||||
let ls = lines s
|
let ls = lines s
|
||||||
let (firstpart, secondpart) = break ("individual inherited" `isInfixOf`) ls
|
let (firstpart, secondpart) = break ("individual inherited" `isInfixOf`) ls
|
||||||
putStr $ unlines firstpart
|
putStr $ unlines firstpart
|
||||||
let fields = map getfields $ filter (not . null) $ drop 2 $ secondpart
|
let fields = map getfields $ filter (not . null) $ drop 2 secondpart
|
||||||
let maxnamelen = maximum $ map (length . head) fields
|
let maxnamelen = maximum $ map (length . head) fields
|
||||||
let fmt = "%-"++(show maxnamelen)++"s %10s %5s %6s %9s %10s"
|
let fmt = "%-"++(show maxnamelen)++"s %10s %5s %6s %9s %10s"
|
||||||
putStrLn $ showheading fmt
|
putStrLn $ showheading fmt
|
||||||
|
Loading…
Reference in New Issue
Block a user