mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-18 17:57:11 +03:00
strip trailing whitespace from all Haskell files
This commit is contained in:
gwern
Simon Michael
parent
22279978af
commit
d1618aaca8
@ -9,7 +9,7 @@ import Hledger.Cli
|
||||
import Text.CSV
|
||||
|
||||
|
||||
argsmode =
|
||||
argsmode =
|
||||
(defCommandMode ["balance-csv"]) {
|
||||
modeHelp = "show matched postings accounts and their balances as CSV"
|
||||
,modeGroupFlags = Group {
|
||||
|
||||
@ -16,7 +16,7 @@ main = do
|
||||
opts <- getCliOpts (defCommandMode ["hledger-print-unique"])
|
||||
withJournalDo opts $
|
||||
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts}
|
||||
where
|
||||
where
|
||||
uniquify = nubBy (\t1 t2 -> thingToCompare t1 == thingToCompare t2) . sortBy (comparing thingToCompare)
|
||||
thingToCompare = tdescription
|
||||
-- thingToCompare = tdate
|
||||
|
||||
@ -35,7 +35,7 @@ cmdmode = (defCommandMode ["hledger-rewrite"]) {
|
||||
,("Reporting", reportflags)
|
||||
,("Misc", helpflags)
|
||||
]
|
||||
,groupUnnamed = [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
|
||||
,groupUnnamed = [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
|
||||
"add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."]
|
||||
,groupHidden = []
|
||||
}
|
||||
@ -66,7 +66,7 @@ amountexprp =
|
||||
|
||||
amountExprRenderer :: Query -> AmountExpr -> (Transaction -> MixedAmount)
|
||||
amountExprRenderer q aex =
|
||||
case aex of
|
||||
case aex of
|
||||
AmountLiteral s -> either parseerror (const . mixed) $ parseWithCtx nullctx amountp s
|
||||
AmountMultiplier n -> (`divideMixedAmount` (1 / n)) . (`firstAmountMatching` q)
|
||||
where
|
||||
@ -93,4 +93,4 @@ main = do
|
||||
let j' = j{jtxns=map (\t -> if q `matchesTransaction` t then rewriteTransaction t addps else t) ts}
|
||||
-- run the print command, showing all transactions
|
||||
print' opts{reportopts_=ropts{query_=""}} j'
|
||||
|
||||
|
||||
|
||||
@ -93,7 +93,7 @@ vty opts j = do
|
||||
,abuf=[]
|
||||
,alocs=[]
|
||||
}
|
||||
go a
|
||||
go a
|
||||
|
||||
-- | Update the screen, wait for the next event, repeat.
|
||||
go :: AppState -> IO ()
|
||||
@ -101,7 +101,7 @@ go a@AppState{av=av,aopts=opts} = do
|
||||
when (not $ debug_vty_ opts) $ update av (renderScreen a)
|
||||
k <- next_event av
|
||||
d <- getCurrentDay
|
||||
case k of
|
||||
case k of
|
||||
EvResize x y -> go $ resize x y a
|
||||
EvKey (KASCII 'l') [MCtrl] -> refresh av >> go a{amsg=helpmsg}
|
||||
EvKey (KASCII 'b') [] -> go $ resetTrailAndEnter d BalanceScreen a
|
||||
@ -151,7 +151,7 @@ setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocSc
|
||||
|
||||
setPosY _ AppState{alocs=[]} = error' "shouldn't happen" -- silence warnings
|
||||
setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}
|
||||
where
|
||||
where
|
||||
l' = setLocScrollY sy $ setLocCursorY cy l
|
||||
ph = pageHeight a
|
||||
cy = y `mod` ph
|
||||
@ -186,7 +186,7 @@ moveDownAndPushEdge a
|
||||
| sy+cy >= bh = a
|
||||
| cy < ph-1 = updateCursorY (+1) a
|
||||
| otherwise = updateScrollY (+1) a
|
||||
where
|
||||
where
|
||||
Loc{sy=sy,cy=cy} = head $ alocs a
|
||||
ph = pageHeight a
|
||||
bh = length $ abuf a
|
||||
@ -332,7 +332,7 @@ renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =
|
||||
renderStatus w msg
|
||||
,pic_background = Background ' ' def_attr
|
||||
}
|
||||
where
|
||||
where
|
||||
(cx, cy) = (0, cursorY a)
|
||||
sy = scrollY a
|
||||
-- mainimg = (renderString attr $ unlines $ above)
|
||||
@ -381,8 +381,8 @@ theme = Restrained
|
||||
|
||||
data UITheme = Restrained | Colorful | Blood
|
||||
|
||||
(defaultattr,
|
||||
currentlineattr,
|
||||
(defaultattr,
|
||||
currentlineattr,
|
||||
statusattr
|
||||
) = case theme of
|
||||
Restrained -> (def_attr
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-|
|
||||
{-|
|
||||
|
||||
The Hledger.Data library allows parsing and querying of C++ ledger-style
|
||||
journal files. It generally provides a compatible subset of C++ ledger's
|
||||
|
||||
@ -115,7 +115,7 @@ sumAccounts a
|
||||
|
||||
-- | Remove all subaccounts below a certain depth.
|
||||
clipAccounts :: Int -> Account -> Account
|
||||
clipAccounts 0 a = a{asubs=[]}
|
||||
clipAccounts 0 a = a{asubs=[]}
|
||||
clipAccounts d a = a{asubs=subs}
|
||||
where
|
||||
subs = map (clipAccounts (d-1)) $ asubs a
|
||||
|
||||
@ -63,7 +63,7 @@ isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
|
||||
isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar])
|
||||
|
||||
isSubAccountNameOf :: AccountName -> AccountName -> Bool
|
||||
s `isSubAccountNameOf` p =
|
||||
s `isSubAccountNameOf` p =
|
||||
(p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))
|
||||
|
||||
-- | From a list of account names, select those which are direct
|
||||
@ -73,7 +73,7 @@ subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts
|
||||
|
||||
-- | Convert a list of account names to a tree.
|
||||
accountNameTreeFrom :: [AccountName] -> Tree AccountName
|
||||
accountNameTreeFrom accts =
|
||||
accountNameTreeFrom accts =
|
||||
Node "root" (accounttreesfrom (topAccountNames accts))
|
||||
where
|
||||
accounttreesfrom :: [AccountName] -> [Tree AccountName]
|
||||
@ -85,7 +85,7 @@ nullaccountnametree = Node "root" []
|
||||
|
||||
-- | Elide an account name to fit in the specified width.
|
||||
-- From the ledger 2.6 news:
|
||||
--
|
||||
--
|
||||
-- @
|
||||
-- What Ledger now does is that if an account name is too long, it will
|
||||
-- start abbreviating the first parts of the account name down to two
|
||||
@ -99,7 +99,7 @@ nullaccountnametree = Node "root" []
|
||||
-- ..:Af:Lu:Sn:Ca:Ch:Cash ; Abbreviated and elided!
|
||||
-- @
|
||||
elideAccountName :: Int -> AccountName -> AccountName
|
||||
elideAccountName width s =
|
||||
elideAccountName width s =
|
||||
elideLeft width $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s
|
||||
where
|
||||
elideparts :: Int -> [String] -> [String] -> [String]
|
||||
|
||||
@ -4,13 +4,13 @@ A simple 'Amount' is some quantity of money, shares, or anything else.
|
||||
It has a (possibly null) 'Commodity' and a numeric quantity:
|
||||
|
||||
@
|
||||
$1
|
||||
$1
|
||||
£-50
|
||||
EUR 3.44
|
||||
EUR 3.44
|
||||
GOOG 500
|
||||
1.5h
|
||||
90 apples
|
||||
0
|
||||
0
|
||||
@
|
||||
|
||||
It may also have an assigned 'Price', representing this amount's per-unit
|
||||
@ -166,7 +166,7 @@ similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{aspre
|
||||
Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} =
|
||||
-- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)
|
||||
amount{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}}
|
||||
-- c1==c2 || q1==0 || q2==0 =
|
||||
-- c1==c2 || q1==0 || q2==0 =
|
||||
-- otherwise = error "tried to do simple arithmetic with amounts in different commodities"
|
||||
|
||||
-- | Convert an amount to the specified commodity, ignoring and discarding
|
||||
@ -605,7 +605,7 @@ tests_Hledger_Data_Amount = TestList $
|
||||
,usd (-0.25)
|
||||
])
|
||||
`is` Mixed [usd 0 `withPrecision` 0]
|
||||
|
||||
|
||||
,"adding mixed amounts with total prices" ~: do
|
||||
(sum $ map (Mixed . (:[]))
|
||||
[usd 1 @@ eur 1
|
||||
|
||||
@ -43,8 +43,8 @@ commoditysymbols =
|
||||
|
||||
-- | Look up one of the sample commodities' symbol by name.
|
||||
comm :: String -> Commodity
|
||||
comm name = snd $ fromMaybe
|
||||
(error' "commodity lookup failed")
|
||||
comm name = snd $ fromMaybe
|
||||
(error' "commodity lookup failed")
|
||||
(find (\n -> fst n == name) commoditysymbols)
|
||||
|
||||
-- | Find the conversion rate between two commodities. Currently returns 1.
|
||||
|
||||
@ -153,7 +153,7 @@ spanStart (DateSpan d _) = d
|
||||
spanEnd :: DateSpan -> Maybe Day
|
||||
spanEnd (DateSpan _ d) = d
|
||||
|
||||
-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra
|
||||
-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra
|
||||
|
||||
-- | Get overall span enclosing multiple sequentially ordered spans.
|
||||
spansSpan :: [DateSpan] -> DateSpan
|
||||
@ -204,7 +204,7 @@ spanContainsDate (DateSpan Nothing Nothing) _ = True
|
||||
spanContainsDate (DateSpan Nothing (Just e)) d = d < e
|
||||
spanContainsDate (DateSpan (Just b) Nothing) d = d >= b
|
||||
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
|
||||
|
||||
|
||||
-- | Calculate the intersection of a number of datespans.
|
||||
spansIntersect [] = nulldatespan
|
||||
spansIntersect [d] = d
|
||||
@ -255,7 +255,7 @@ maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
|
||||
-- dateSpanAsText (DateSpan Nothing (Just e)) = printf "to %s" (show e)
|
||||
-- dateSpanAsText (DateSpan (Just b) Nothing) = printf "from %s" (show b)
|
||||
-- dateSpanAsText (DateSpan (Just b) (Just e)) = printf "%s to %s" (show b) (show e)
|
||||
|
||||
|
||||
-- | Convert a single smart date string to a date span using the provided
|
||||
-- reference date, or raise an error.
|
||||
-- spanFromSmartDateString :: Day -> String -> DateSpan
|
||||
@ -400,9 +400,9 @@ nthdayofweekcontaining n d | d1 >= d = d1
|
||||
|
||||
-- | Parse a couple of date string formats to a time type.
|
||||
parsedateM :: String -> Maybe Day
|
||||
parsedateM s = firstJust [
|
||||
parsedateM s = firstJust [
|
||||
parseTime defaultTimeLocale "%Y/%m/%d" s,
|
||||
parseTime defaultTimeLocale "%Y-%m-%d" s
|
||||
parseTime defaultTimeLocale "%Y-%m-%d" s
|
||||
]
|
||||
|
||||
-- -- | Parse a date-time string to a time type, or raise an error.
|
||||
@ -420,7 +420,7 @@ parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"")
|
||||
parsetimewith :: ParseTime t => String -> String -> t -> t
|
||||
parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s
|
||||
|
||||
{-|
|
||||
{-|
|
||||
Parse a date in any of the formats allowed in ledger's period expressions,
|
||||
and maybe some others:
|
||||
|
||||
@ -557,7 +557,7 @@ lastthisnextthing = do
|
||||
]
|
||||
-- XXX support these in fixSmartDate
|
||||
-- ++ (map string $ months ++ monthabbrevs ++ weekdays ++ weekdayabbrevs)
|
||||
|
||||
|
||||
return ("",r,p)
|
||||
|
||||
periodexpr :: Day -> GenParser Char st (Interval, DateSpan)
|
||||
|
||||
@ -463,7 +463,7 @@ splitAssertions ps
|
||||
| otherwise = (ps'++[head rest]):splitAssertions (tail rest)
|
||||
where
|
||||
(ps',rest) = break (isJust . pbalanceassertion) ps
|
||||
|
||||
|
||||
-- | Fill in any missing amounts and check that all journal transactions
|
||||
-- balance, or return an error message. This is done after parsing all
|
||||
-- amounts and working out the canonical commodities, since balancing
|
||||
@ -654,7 +654,7 @@ abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
|
||||
-- liabilities:debts $1
|
||||
-- assets:bank:checking
|
||||
--
|
||||
Right samplejournal = journalBalanceTransactions $
|
||||
Right samplejournal = journalBalanceTransactions $
|
||||
nulljournal
|
||||
{jtxns = [
|
||||
txnTieKnot $ Transaction {
|
||||
|
||||
@ -122,7 +122,7 @@ sumPostings = sum . map pamount
|
||||
-- there is no parent transaction.
|
||||
postingDate :: Posting -> Day
|
||||
postingDate p = fromMaybe txndate $ pdate p
|
||||
where
|
||||
where
|
||||
txndate = maybe nulldate tdate $ ptransaction p
|
||||
|
||||
-- | Get a posting's secondary (secondary) date, which is the first of:
|
||||
@ -251,4 +251,4 @@ tests_Hledger_Data_Posting = TestList [
|
||||
concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)"
|
||||
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -24,17 +24,17 @@ import Hledger.Data.Amount
|
||||
import Hledger.Data.Posting
|
||||
import Hledger.Data.Transaction
|
||||
|
||||
instance Show TimeLogEntry where
|
||||
instance Show TimeLogEntry where
|
||||
show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t)
|
||||
|
||||
instance Show TimeLogCode where
|
||||
instance Show TimeLogCode where
|
||||
show SetBalance = "b"
|
||||
show SetRequiredHours = "h"
|
||||
show In = "i"
|
||||
show Out = "o"
|
||||
show FinalOut = "O"
|
||||
|
||||
instance Read TimeLogCode where
|
||||
instance Read TimeLogCode where
|
||||
readsPrec _ ('b' : xs) = [(SetBalance, xs)]
|
||||
readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)]
|
||||
readsPrec _ ('i' : xs) = [(In, xs)]
|
||||
@ -72,7 +72,7 @@ timeLogEntriesToTransactions now (i:o:rest)
|
||||
entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction
|
||||
entryFromTimeLogInOut i o
|
||||
| otime >= itime = t
|
||||
| otherwise =
|
||||
| otherwise =
|
||||
error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
|
||||
where
|
||||
t = Transaction {
|
||||
@ -119,8 +119,8 @@ tests_Hledger_Data_TimeLog = TestList [
|
||||
assertEntriesGiveStrings "split multi-day sessions at each midnight"
|
||||
[clockin (mktime (addDays (-2) today) "23:00:00") ""]
|
||||
["23:00-23:59","00:00-23:59","00:00-"++nowstr]
|
||||
assertEntriesGiveStrings "auto-clock-out if needed"
|
||||
[clockin (mktime today "00:00:00") ""]
|
||||
assertEntriesGiveStrings "auto-clock-out if needed"
|
||||
[clockin (mktime today "00:00:00") ""]
|
||||
["00:00-"++nowstr]
|
||||
let future = utcToLocalTime tz $ addUTCTime 100 now'
|
||||
futurestr = showtime future
|
||||
|
||||
@ -50,10 +50,10 @@ import Hledger.Data.Amount
|
||||
|
||||
instance Show Transaction where show = showTransactionUnelided
|
||||
|
||||
instance Show ModifierTransaction where
|
||||
instance Show ModifierTransaction where
|
||||
show t = "= " ++ mtvalueexpr t ++ "\n" ++ unlines (map show (mtpostings t))
|
||||
|
||||
instance Show PeriodicTransaction where
|
||||
instance Show PeriodicTransaction where
|
||||
show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t))
|
||||
|
||||
nullsourcepos :: SourcePos
|
||||
@ -64,9 +64,9 @@ nulltransaction = Transaction {
|
||||
tsourcepos=nullsourcepos,
|
||||
tdate=nulldate,
|
||||
tdate2=Nothing,
|
||||
tstatus=False,
|
||||
tcode="",
|
||||
tdescription="",
|
||||
tstatus=False,
|
||||
tcode="",
|
||||
tdescription="",
|
||||
tcomment="",
|
||||
ttags=[],
|
||||
tpostings=[],
|
||||
@ -286,7 +286,7 @@ balanceTransaction styles t@Transaction{tpostings=ps}
|
||||
ramounts = map pamount rwithamounts
|
||||
bvamounts = map pamount bvwithamounts
|
||||
t' = t{tpostings=map inferamount ps}
|
||||
where
|
||||
where
|
||||
inferamount p | not (hasAmount p) && isReal p = p{pamount = costOfMixedAmount (- sum ramounts)}
|
||||
| not (hasAmount p) && isBalancedVirtual p = p{pamount = costOfMixedAmount (- sum bvamounts)}
|
||||
| otherwise = p
|
||||
|
||||
@ -45,7 +45,7 @@ type AccountName = String
|
||||
data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data)
|
||||
|
||||
type Commodity = String
|
||||
|
||||
|
||||
type Quantity = Double
|
||||
|
||||
-- | An amount's price (none, per unit, or total) in another commodity.
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-|
|
||||
{-|
|
||||
|
||||
This is the entry point to hledger's reading system, which can read
|
||||
Journals from various data formats. Use this module if you want to parse
|
||||
@ -138,7 +138,7 @@ readJournal format rulesfile assrt path s =
|
||||
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
|
||||
readersFor (format,path,s) =
|
||||
dbg ("possible readers for "++show (format,path,elideRight 30 s)) $
|
||||
case format of
|
||||
case format of
|
||||
Just f -> case readerForStorageFormat f of Just r -> [r]
|
||||
Nothing -> []
|
||||
Nothing -> case path of Nothing -> readers
|
||||
@ -149,7 +149,7 @@ readersFor (format,path,s) =
|
||||
readerForStorageFormat :: StorageFormat -> Maybe Reader
|
||||
readerForStorageFormat s | null rs = Nothing
|
||||
| otherwise = Just $ head rs
|
||||
where
|
||||
where
|
||||
rs = filter ((s==).rFormat) readers :: [Reader]
|
||||
|
||||
-- | Find the readers which think they can handle the given file path and data, if any.
|
||||
|
||||
@ -154,7 +154,7 @@ journal = do
|
||||
eof
|
||||
finalctx <- getState
|
||||
return $ (combineJournalUpdates journalupdates, finalctx)
|
||||
where
|
||||
where
|
||||
-- As all journal line types can be distinguished by the first
|
||||
-- character, excepting transactions versus empty (blank or
|
||||
-- comment-only) lines, can use choice w/o try
|
||||
@ -354,7 +354,7 @@ test_transaction = do
|
||||
assertEqual (ttags t) (ttags t2)
|
||||
assertEqual (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
|
||||
assertEqual (show $ tpostings t) (show $ tpostings t2)
|
||||
-- "0000/01/01\n\n" `gives` nulltransaction
|
||||
-- "0000/01/01\n\n" `gives` nulltransaction
|
||||
unlines [
|
||||
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
|
||||
" ; tcomment2",
|
||||
@ -412,7 +412,7 @@ test_transaction = do
|
||||
," b"
|
||||
," "
|
||||
]
|
||||
|
||||
|
||||
let p = parseWithCtx nullctx transaction $ unlines
|
||||
["2009/1/1 x ; transaction comment"
|
||||
," a 1 ; posting 1 comment"
|
||||
@ -422,7 +422,7 @@ test_transaction = do
|
||||
]
|
||||
assertRight p
|
||||
assertEqual 2 (let Right t = p in length $ tpostings t)
|
||||
#endif
|
||||
#endif
|
||||
|
||||
-- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year
|
||||
-- may be omitted if a default year has already been set.
|
||||
@ -501,7 +501,7 @@ codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `m
|
||||
-- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments.
|
||||
postings :: GenParser Char JournalContext [Posting]
|
||||
postings = many1 (try postingp) <?> "postings"
|
||||
|
||||
|
||||
-- linebeginningwithspaces :: GenParser Char JournalContext String
|
||||
-- linebeginningwithspaces = do
|
||||
-- sp <- many1 spacenonewline
|
||||
@ -532,7 +532,7 @@ postingp = do
|
||||
test_postingp = do
|
||||
let s `gives` ep = do
|
||||
let parse = parseWithCtx nullctx postingp s
|
||||
assertBool -- "postingp parser"
|
||||
assertBool -- "postingp parser"
|
||||
$ isRight parse
|
||||
let Right ap = parse
|
||||
same f = assertEqual (f ep) (f ap)
|
||||
@ -547,21 +547,21 @@ test_postingp = do
|
||||
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" `gives`
|
||||
posting{paccount="expenses:food:dining", pamount=Mixed [usd 10], pcomment=" a: a a \n b: b b \n", ptags=[("a","a a"), ("b","b b")]}
|
||||
|
||||
" a 1 ; [2012/11/28]\n" `gives`
|
||||
" a 1 ; [2012/11/28]\n" `gives`
|
||||
("a" `post` num 1){pcomment=" [2012/11/28]\n"
|
||||
,ptags=[("date","2012/11/28")]
|
||||
,pdate=parsedateM "2012/11/28"}
|
||||
|
||||
" a 1 ; a:a, [=2012/11/28]\n" `gives`
|
||||
" a 1 ; a:a, [=2012/11/28]\n" `gives`
|
||||
("a" `post` num 1){pcomment=" a:a, [=2012/11/28]\n"
|
||||
,ptags=[("a","a"), ("date2","2012/11/28")]
|
||||
,pdate=Nothing}
|
||||
|
||||
" a 1 ; a:a\n ; [2012/11/28=2012/11/29],b:b\n" `gives`
|
||||
" a 1 ; a:a\n ; [2012/11/28=2012/11/29],b:b\n" `gives`
|
||||
("a" `post` num 1){pcomment=" a:a\n [2012/11/28=2012/11/29],b:b\n"
|
||||
,ptags=[("a","a"), ("date","2012/11/28"), ("date2","2012/11/29"), ("b","b")]
|
||||
,pdate=parsedateM "2012/11/28"}
|
||||
|
||||
|
||||
assertBool -- "postingp parses a quoted commodity with numbers"
|
||||
(isRight $ parseWithCtx nullctx postingp " a 1 \"DE123\"\n")
|
||||
|
||||
@ -573,7 +573,7 @@ test_postingp = do
|
||||
-- let Right p = parse
|
||||
-- assertEqual "next-line comment\n" (pcomment p)
|
||||
-- assertEqual (Just nullmixedamt) (pbalanceassertion p)
|
||||
#endif
|
||||
#endif
|
||||
|
||||
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
|
||||
modifiedaccountname :: GenParser Char JournalContext AccountName
|
||||
@ -595,7 +595,7 @@ accountnamep = do
|
||||
when (accountNameFromComponents (accountNameComponents a') /= a')
|
||||
(fail $ "account name seems ill-formed: "++a')
|
||||
return a'
|
||||
where
|
||||
where
|
||||
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
|
||||
-- couldn't avoid consuming a final space sometimes, harmless
|
||||
striptrailingspace s = if last s == ' ' then init s else s
|
||||
@ -625,7 +625,7 @@ test_spaceandamountormissing = do
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt
|
||||
#endif
|
||||
#endif
|
||||
|
||||
-- | Parse a single-commodity amount, with optional symbol on the left or
|
||||
-- right, optional unit or total price, and optional (ignored)
|
||||
@ -645,7 +645,7 @@ test_amountp = do
|
||||
assertParseEqual'
|
||||
(parseWithCtx nullctx amountp "$10 @@ €5")
|
||||
(usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
-- | Parse an amount from a string, or get an error.
|
||||
amountp' :: String -> Amount
|
||||
@ -664,7 +664,7 @@ signp = do
|
||||
leftsymbolamount :: GenParser Char JournalContext Amount
|
||||
leftsymbolamount = do
|
||||
sign <- signp
|
||||
c <- commoditysymbol
|
||||
c <- commoditysymbol
|
||||
sp <- many spacenonewline
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
|
||||
@ -761,16 +761,16 @@ fixedlotprice =
|
||||
|
||||
-- | Parse a string representation of a number for its value and display
|
||||
-- attributes.
|
||||
--
|
||||
--
|
||||
-- Some international number formats are accepted, eg either period or comma
|
||||
-- may be used for the decimal point, and the other of these may be used for
|
||||
-- separating digit groups in the integer part. See
|
||||
-- http://en.wikipedia.org/wiki/Decimal_separator for more examples.
|
||||
--
|
||||
--
|
||||
-- This returns: the parsed numeric value, the precision (number of digits
|
||||
-- seen following the decimal point), the decimal point character used if any,
|
||||
-- and the digit group style if any.
|
||||
--
|
||||
--
|
||||
numberp :: GenParser Char JournalContext (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
|
||||
numberp = do
|
||||
-- a number is an optional sign followed by a sequence of digits possibly
|
||||
@ -820,11 +820,11 @@ numberp = do
|
||||
<?> "numberp"
|
||||
where
|
||||
numeric = isNumber . headDef '_'
|
||||
|
||||
|
||||
#ifdef TESTS
|
||||
test_numberp = do
|
||||
let s `is` n = assertParseEqual' (parseWithCtx nullctx numberp s) n
|
||||
assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
|
||||
assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
|
||||
assertFails ""
|
||||
"0" `is` (0, 0, '.', ',', [])
|
||||
"1" `is` (1, 0, '.', ',', [])
|
||||
@ -843,7 +843,7 @@ test_numberp = do
|
||||
assertFails "1..1"
|
||||
assertFails ".1,"
|
||||
assertFails ",1."
|
||||
#endif
|
||||
#endif
|
||||
|
||||
-- comment parsers
|
||||
|
||||
@ -878,7 +878,7 @@ tagsInComment :: String -> [Tag]
|
||||
tagsInComment c = concatMap tagsInCommentLine $ lines c'
|
||||
where
|
||||
c' = ledgerDateSyntaxToTags c
|
||||
|
||||
|
||||
tagsInCommentLine :: String -> [Tag]
|
||||
tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ','
|
||||
where
|
||||
@ -913,7 +913,7 @@ ledgerDateSyntaxToTags = regexReplaceBy "\\[[-.\\/0-9=]+\\]" replace
|
||||
replace' ('=':s) | isdate s = date2tag s
|
||||
replace' s | last s =='=' && isdate (init s) = datetag (init s)
|
||||
replace' s | length ds == 2 && isdate d1 && isdate d1 = datetag d1 ++ date2tag d2
|
||||
where
|
||||
where
|
||||
ds = splitAtElement '=' s
|
||||
d1 = headDef "" ds
|
||||
d2 = lastDef "" ds
|
||||
@ -922,17 +922,17 @@ ledgerDateSyntaxToTags = regexReplaceBy "\\[[-.\\/0-9=]+\\]" replace
|
||||
isdate = isJust . parsedateM
|
||||
datetag s = "date:"++s++", "
|
||||
date2tag s = "date2:"++s++", "
|
||||
|
||||
|
||||
#ifdef TESTS
|
||||
test_ledgerDateSyntaxToTags = do
|
||||
assertEqual "date2:2012/11/28, " $ ledgerDateSyntaxToTags "[=2012/11/28]"
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
dateValueFromTags, date2ValueFromTags :: [Tag] -> Maybe String
|
||||
dateValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date") . fst) ts
|
||||
date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts
|
||||
|
||||
|
||||
|
||||
{- old hunit tests
|
||||
|
||||
test_Hledger_Read_JournalReader = TestList $ concat [
|
||||
|
||||
@ -86,7 +86,7 @@ timelogFile = do items <- many timelogItem
|
||||
eof
|
||||
ctx <- getState
|
||||
return (liftM (foldr (.) id) $ sequence items, ctx)
|
||||
where
|
||||
where
|
||||
-- As all ledger line types can be distinguished by the first
|
||||
-- character, excepting transactions versus empty (blank or
|
||||
-- comment-only) lines, can use choice w/o try
|
||||
|
||||
@ -39,9 +39,9 @@ type BalanceReportItem = (RenderableAccountName, MixedAmount)
|
||||
-- It has:
|
||||
--
|
||||
-- * The full account name
|
||||
--
|
||||
--
|
||||
-- * The ledger-style short elided account name (the leaf name, prefixed by any boring parents immediately above)
|
||||
--
|
||||
--
|
||||
-- * The number of indentation steps to use when rendering a ledger-style account tree
|
||||
-- (normally the 0-based depth of this account excluding boring parents, or 0 with --flat).
|
||||
type RenderableAccountName = (AccountName, AccountName, Int)
|
||||
@ -67,14 +67,14 @@ balanceReport opts q j = (items, total)
|
||||
|
||||
accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
|
||||
accts' :: [Account]
|
||||
| flat_ opts = dbg "accts" $
|
||||
| flat_ opts = dbg "accts" $
|
||||
filterzeros $
|
||||
filterempty $
|
||||
drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts
|
||||
| otherwise = dbg "accts" $
|
||||
| otherwise = dbg "accts" $
|
||||
filter (not.aboring) $
|
||||
drop 1 $ flattenAccounts $
|
||||
markboring $
|
||||
markboring $
|
||||
prunezeros $ clipAccounts (queryDepth q) accts
|
||||
where
|
||||
balance = if flat_ opts then aebalance else aibalance
|
||||
@ -247,7 +247,7 @@ tests_balanceReport =
|
||||
," 0"
|
||||
]
|
||||
|
||||
,"accounts report with unmatched parent of two matched subaccounts" ~:
|
||||
,"accounts report with unmatched parent of two matched subaccounts" ~:
|
||||
defreportopts{patterns_=["cash","saving"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
@ -256,7 +256,7 @@ tests_balanceReport =
|
||||
," $-1"
|
||||
]
|
||||
|
||||
,"accounts report with multi-part account name" ~:
|
||||
,"accounts report with multi-part account name" ~:
|
||||
defreportopts{patterns_=["expenses:food"]} `gives`
|
||||
[" $1 expenses:food"
|
||||
,"--------------------"
|
||||
@ -276,13 +276,13 @@ tests_balanceReport =
|
||||
," $1"
|
||||
]
|
||||
|
||||
,"accounts report negative account pattern always matches full name" ~:
|
||||
,"accounts report negative account pattern always matches full name" ~:
|
||||
defreportopts{patterns_=["not:e"]} `gives`
|
||||
["--------------------"
|
||||
," 0"
|
||||
]
|
||||
|
||||
,"accounts report negative patterns affect totals" ~:
|
||||
,"accounts report negative patterns affect totals" ~:
|
||||
defreportopts{patterns_=["expenses","not:food"]} `gives`
|
||||
[" $1 expenses:supplies"
|
||||
,"--------------------"
|
||||
@ -317,7 +317,7 @@ tests_balanceReport =
|
||||
-}
|
||||
]
|
||||
|
||||
Right samplejournal2 = journalBalanceTransactions $
|
||||
Right samplejournal2 = journalBalanceTransactions $
|
||||
nulljournal
|
||||
{jtxns = [
|
||||
txnTieKnot $ Transaction {
|
||||
@ -337,12 +337,12 @@ Right samplejournal2 = journalBalanceTransactions $
|
||||
}
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
-- tests_isInterestingIndented = [
|
||||
-- "isInterestingIndented" ~: do
|
||||
-- "isInterestingIndented" ~: do
|
||||
-- let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
|
||||
-- where l = ledgerFromJournal (queryFromOpts nulldate opts) journal
|
||||
|
||||
|
||||
-- (defreportopts, samplejournal, "expenses") `gives` True
|
||||
-- ]
|
||||
|
||||
|
||||
@ -107,7 +107,7 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totals)
|
||||
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
|
||||
postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as]
|
||||
where
|
||||
as = depthLimit $
|
||||
as = depthLimit $
|
||||
(if tree_ opts then id else filter ((>0).anumpostings)) $
|
||||
drop 1 $ accountsFromPostings ps
|
||||
depthLimit
|
||||
|
||||
@ -70,7 +70,7 @@ postingsReport opts q j = (totallabel, items)
|
||||
beforeendq = dbg "beforeendq" $ dateqcons $ DateSpan Nothing reportend
|
||||
reportq = dbg "reportq" $ depthless $ And [datelessq, beforeendq] -- user's query with no start date, end date on an interval boundary and no depth limit
|
||||
|
||||
pstoend =
|
||||
pstoend =
|
||||
dbg "ps4" $ sortBy (comparing pdate) $ -- sort postings by date (or date2)
|
||||
dbg "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude
|
||||
dbg "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
|
||||
@ -172,7 +172,7 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps
|
||||
anames = sort $ nub $ map paccount ps
|
||||
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
|
||||
accts = accountsFromPostings ps
|
||||
balance a = maybe nullmixedamt bal $ lookupAccount a accts
|
||||
balance a = maybe nullmixedamt bal $ lookupAccount a accts
|
||||
where
|
||||
bal = if isclipped a then aibalance else aebalance
|
||||
isclipped a = accountNameLevel a >= depth
|
||||
@ -262,7 +262,7 @@ tests_postingsReport = [
|
||||
]
|
||||
|
||||
,"postings report with cleared option" ~:
|
||||
do
|
||||
do
|
||||
let opts = defreportopts{cleared_=True}
|
||||
j <- readJournal' sample_journal_str
|
||||
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
|
||||
@ -274,7 +274,7 @@ tests_postingsReport = [
|
||||
]
|
||||
|
||||
,"postings report with uncleared option" ~:
|
||||
do
|
||||
do
|
||||
let opts = defreportopts{uncleared_=True}
|
||||
j <- readJournal' sample_journal_str
|
||||
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
|
||||
@ -287,7 +287,7 @@ tests_postingsReport = [
|
||||
]
|
||||
|
||||
,"postings report sorts by date" ~:
|
||||
do
|
||||
do
|
||||
j <- readJournal' $ unlines
|
||||
["2008/02/02 a"
|
||||
," b 1"
|
||||
@ -309,7 +309,7 @@ tests_postingsReport = [
|
||||
]
|
||||
|
||||
,"postings report with account pattern, case insensitive" ~:
|
||||
do
|
||||
do
|
||||
j <- samplejournal
|
||||
let opts = defreportopts{patterns_=["cAsH"]}
|
||||
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
|
||||
@ -317,9 +317,9 @@ tests_postingsReport = [
|
||||
]
|
||||
|
||||
,"postings report with display expression" ~:
|
||||
do
|
||||
do
|
||||
j <- samplejournal
|
||||
let gives displayexpr =
|
||||
let gives displayexpr =
|
||||
(registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)
|
||||
where opts = defreportopts{display_=Just displayexpr}
|
||||
"d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"]
|
||||
@ -329,7 +329,7 @@ tests_postingsReport = [
|
||||
"d>[2008/6/2]" `gives` ["2008/06/03","2008/12/31"]
|
||||
|
||||
,"postings report with period expression" ~:
|
||||
do
|
||||
do
|
||||
j <- samplejournal
|
||||
let periodexpr `gives` dates = do
|
||||
j' <- samplejournal
|
||||
@ -359,7 +359,7 @@ tests_postingsReport = [
|
||||
]
|
||||
|
||||
, "postings report with depth arg" ~:
|
||||
do
|
||||
do
|
||||
j <- samplejournal
|
||||
let opts = defreportopts{depth_=Just 2}
|
||||
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
|
||||
|
||||
@ -120,7 +120,7 @@ accountTransactionsReport opts j q thisacctquery = (label, items)
|
||||
ts3 = map (setTransactionDateToPostingDate q thisacctquery) ts2
|
||||
-- and sorted
|
||||
ts = sortBy (comparing tdate) ts3
|
||||
|
||||
|
||||
-- starting balance: if we are filtering by a start date and nothing else,
|
||||
-- the sum of postings to this account before that date; otherwise zero.
|
||||
(startbal,label) | queryIsNull q = (nullmixedamt, balancelabel)
|
||||
|
||||
@ -251,7 +251,7 @@ difforzero a b = maximum [(a - b), 0]
|
||||
-- lists
|
||||
|
||||
splitAtElement :: Eq a => a -> [a] -> [[a]]
|
||||
splitAtElement e l =
|
||||
splitAtElement e l =
|
||||
case dropWhile (e==) l of
|
||||
[] -> []
|
||||
l' -> first : splitAtElement e rest
|
||||
@ -285,7 +285,7 @@ subtreeinforest _ [] = Nothing
|
||||
subtreeinforest v (t:ts) = case (subtreeat v t) of
|
||||
Just t' -> Just t'
|
||||
Nothing -> subtreeinforest v ts
|
||||
|
||||
|
||||
-- | remove all nodes past a certain depth
|
||||
treeprune :: Int -> Tree a -> Tree a
|
||||
treeprune 0 t = Node (root t) []
|
||||
@ -297,15 +297,15 @@ treemap f t = Node (f $ root t) (map (treemap f) $ branches t)
|
||||
|
||||
-- | remove all subtrees whose nodes do not fulfill predicate
|
||||
treefilter :: (a -> Bool) -> Tree a -> Tree a
|
||||
treefilter f t = Node
|
||||
(root t)
|
||||
treefilter f t = Node
|
||||
(root t)
|
||||
(map (treefilter f) $ filter (treeany f) $ branches t)
|
||||
|
||||
|
||||
-- | is predicate true in any node of tree ?
|
||||
treeany :: (a -> Bool) -> Tree a -> Bool
|
||||
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.
|
||||
|
||||
-- | show a compact ascii representation of a tree
|
||||
@ -605,7 +605,7 @@ applyN :: Int -> (a -> a) -> a -> a
|
||||
applyN n f = (!! n) . iterate f
|
||||
|
||||
-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one,
|
||||
-- given the current directory. ~username is not supported. Leave "-" unchanged.
|
||||
-- given the current directory. ~username is not supported. Leave "-" unchanged.
|
||||
expandPath :: MonadIO m => FilePath -> FilePath -> m FilePath -- general type sig for use in reader parsers
|
||||
expandPath _ "-" = return "-"
|
||||
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandPath' p
|
||||
|
||||
@ -116,7 +116,7 @@ replaceAll re f s = start end
|
||||
where
|
||||
(_, end, start) = foldl' go (0, s, id) $ getAllMatches $ match re s
|
||||
go (ind,read,write) (off,len) =
|
||||
let (skip, start) = splitAt (off - ind) read
|
||||
(matched, remaining) = splitAt len start
|
||||
let (skip, start) = splitAt (off - ind) read
|
||||
(matched, remaining) = splitAt len start
|
||||
in (off + len, remaining, write . (skip++) . (f matched ++))
|
||||
|
||||
|
||||
@ -111,7 +111,7 @@ registerChartHtml percommoditytxnreports =
|
||||
\$('#register-chart-label').text('#{charttitle}');
|
||||
var seriesData = [
|
||||
$forall (c,(_,items)) <- percommoditytxnreports
|
||||
/* we render each commodity using two series:
|
||||
/* we render each commodity using two series:
|
||||
* one with extra data points added to show a stepped balance line */
|
||||
{
|
||||
data: [
|
||||
@ -128,7 +128,7 @@ registerChartHtml percommoditytxnreports =
|
||||
show: true,
|
||||
steps: true,
|
||||
},
|
||||
points: {
|
||||
points: {
|
||||
show: false,
|
||||
},
|
||||
clickable: false,
|
||||
@ -152,7 +152,7 @@ registerChartHtml percommoditytxnreports =
|
||||
lines: {
|
||||
show: false,
|
||||
},
|
||||
points: {
|
||||
points: {
|
||||
show: true,
|
||||
},
|
||||
},
|
||||
|
||||
@ -29,7 +29,7 @@ webflags = [
|
||||
,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "BASEURL" ("set the base url (default: "++defbaseurlexample++")")
|
||||
,flagReq ["file-url"] (\s opts -> Right $ setopt "file-url" s opts) "FILEURL" ("set the static files url (default: BASEURL/static)")
|
||||
]
|
||||
|
||||
|
||||
webmode :: Mode [([Char], [Char])]
|
||||
webmode = (mode "hledger-web" [("command","web")]
|
||||
"start serving the hledger web interface"
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-|
|
||||
{-|
|
||||
|
||||
Hledger.Cli re-exports the options, utilities and commands provided by
|
||||
the hledger command-line program. This module also aggregates the
|
||||
@ -69,19 +69,19 @@ tests_Hledger_Cli = TestList
|
||||
j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1}
|
||||
in TestList
|
||||
[
|
||||
"account directive 1" ~: sameParse
|
||||
"account directive 1" ~: sameParse
|
||||
"2008/12/07 One\n test:from $-1\n test:to $1\n"
|
||||
"!account test\n2008/12/07 One\n from $-1\n to $1\n"
|
||||
|
||||
,"account directive 2" ~: sameParse
|
||||
,"account directive 2" ~: sameParse
|
||||
"2008/12/07 One\n test:foo:from $-1\n test:foo:to $1\n"
|
||||
"!account test\n!account foo\n2008/12/07 One\n from $-1\n to $1\n"
|
||||
|
||||
,"account directive 3" ~: sameParse
|
||||
,"account directive 3" ~: sameParse
|
||||
"2008/12/07 One\n test:from $-1\n test:to $1\n"
|
||||
"!account test\n!account foo\n!end\n2008/12/07 One\n from $-1\n to $1\n"
|
||||
|
||||
,"account directive 4" ~: sameParse
|
||||
,"account directive 4" ~: sameParse
|
||||
("2008/12/07 One\n alpha $-1\n beta $1\n" ++
|
||||
"!account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++
|
||||
"!account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++
|
||||
@ -136,7 +136,7 @@ tests_Hledger_Cli = TestList
|
||||
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- fixtures/test data
|
||||
|
||||
-- date1 = parsedate "2008/11/26"
|
||||
@ -340,7 +340,7 @@ defaultyear_journal_str = unlines
|
||||
-- ]
|
||||
|
||||
journal7 :: Journal
|
||||
journal7 = nulljournal {jtxns =
|
||||
journal7 = nulljournal {jtxns =
|
||||
[
|
||||
txnTieKnot Transaction {
|
||||
tsourcepos=nullsourcepos,
|
||||
|
||||
@ -20,7 +20,7 @@ import Safe (headDef, headMay)
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
|
||||
import System.Console.Haskeline.Completion
|
||||
import System.Console.Wizard
|
||||
import System.Console.Wizard
|
||||
import System.Console.Wizard.Haskeline
|
||||
import System.IO ( stderr, hPutStr, hPutStrLn )
|
||||
import Text.ParserCombinators.Parsec hiding (Line)
|
||||
@ -128,9 +128,9 @@ confirmedTransactionWizard es@EntryState{..} = do
|
||||
-- liftIO $ hPrintf stderr {- "Transaction entered:\n%s" -} (show t)
|
||||
output $ show t
|
||||
y <- let def = "y" in
|
||||
retryMsg "Please enter y or n." $
|
||||
parser ((fmap ('y' ==)) . headMay . map toLower . strip) $
|
||||
defaultTo' def $ nonEmpty $
|
||||
retryMsg "Please enter y or n." $
|
||||
parser ((fmap ('y' ==)) . headMay . map toLower . strip) $
|
||||
defaultTo' def $ nonEmpty $
|
||||
maybeRestartTransaction $
|
||||
line $ green $ printf "Save this transaction to the journal ?%s: " (showDefault def)
|
||||
if y then return t else throw RestartTransactionException
|
||||
@ -167,10 +167,10 @@ similarTransaction EntryState{..} desc =
|
||||
|
||||
dateAndCodeWizard EntryState{..} = do
|
||||
let def = headDef (showDate esDefDate) esArgs
|
||||
retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
|
||||
parser (parseSmartDateAndCode esToday) $
|
||||
retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
|
||||
parser (parseSmartDateAndCode esToday) $
|
||||
withCompletion (dateCompleter def) $
|
||||
defaultTo' def $ nonEmpty $
|
||||
defaultTo' def $ nonEmpty $
|
||||
maybeExit $
|
||||
maybeRestartTransaction $
|
||||
-- maybeShowHelp $
|
||||
@ -191,7 +191,7 @@ dateAndCodeWizard EntryState{..} = do
|
||||
descriptionAndCommentWizard EntryState{..} = do
|
||||
let def = headDef "" esArgs
|
||||
s <- withCompletion (descriptionCompleter esJournal def) $
|
||||
defaultTo' def $ nonEmpty $
|
||||
defaultTo' def $ nonEmpty $
|
||||
maybeRestartTransaction $
|
||||
line $ green $ printf "Description%s: " (showDefault def)
|
||||
let (desc,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') s
|
||||
@ -233,7 +233,7 @@ accountWizard EntryState{..} = do
|
||||
retryMsg "A valid hledger account name is required. Eg: assets:cash, expenses:food:eating out." $
|
||||
parser (parseAccountOrDotOrNull def canfinish) $
|
||||
withCompletion (accountCompleter esJournal def) $
|
||||
defaultTo' def $ -- nonEmpty $
|
||||
defaultTo' def $ -- nonEmpty $
|
||||
maybeRestartTransaction $
|
||||
line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)
|
||||
where
|
||||
@ -259,12 +259,12 @@ amountAndCommentWizard EntryState{..} = do
|
||||
_ | pnum > 1 && not (isZeroMixedAmount balancingamt) -> showamt balancingamt
|
||||
_ -> ""
|
||||
retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $
|
||||
parser parseAmountAndComment $
|
||||
parser parseAmountAndComment $
|
||||
withCompletion (amountCompleter def) $
|
||||
defaultTo' def $ nonEmpty $
|
||||
defaultTo' def $ nonEmpty $
|
||||
maybeRestartTransaction $
|
||||
line $ green $ printf "Amount %d%s: " pnum (showDefault def)
|
||||
where
|
||||
where
|
||||
parseAmountAndComment = either (const Nothing) Just . parseWithCtx nodefcommodityctx amountandcommentp
|
||||
nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing}
|
||||
amountandcommentp = do
|
||||
@ -298,7 +298,7 @@ maybeExit = parser (\s -> if s=="." then throw UnexpectedEOF else Just s)
|
||||
maybeRestartTransaction = parser (\s -> if s=="<" then throw RestartTransactionException else Just s)
|
||||
|
||||
-- maybeShowHelp :: Wizard Haskeline String -> Wizard Haskeline String
|
||||
-- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $
|
||||
-- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $
|
||||
-- parser (\s -> if s=="?" then Nothing else Just s) wizard
|
||||
|
||||
-- Completion helpers
|
||||
|
||||
@ -129,7 +129,7 @@ There are three kinds of multi-column balance report, indicated by the heading:
|
||||
period. Here, checking's balance increased by 10 in Feb:
|
||||
|
||||
> Change of balance (flow):
|
||||
>
|
||||
>
|
||||
> Jan Feb Mar
|
||||
> assets:checking 20 10 -5
|
||||
|
||||
@ -138,7 +138,7 @@ There are three kinds of multi-column balance report, indicated by the heading:
|
||||
Here, 30 is the sum of checking postings during Jan and Feb:
|
||||
|
||||
> Ending balance (cumulative):
|
||||
>
|
||||
>
|
||||
> Jan Feb Mar
|
||||
> assets:checking 20 30 25
|
||||
|
||||
@ -148,7 +148,7 @@ There are three kinds of multi-column balance report, indicated by the heading:
|
||||
pre-Jan postings which created a starting balance of 100:
|
||||
|
||||
> Ending balance (historical):
|
||||
>
|
||||
>
|
||||
> Jan Feb Mar
|
||||
> assets:checking 120 130 125
|
||||
|
||||
@ -161,7 +161,7 @@ Here's a (imperfect?) specification for the eliding/omitting behaviour:
|
||||
* An account less deep than the report's max depth, with just one
|
||||
interesting subaccount, and the same balance as the subaccount, is
|
||||
non-interesting, and prefixed to the subaccount's line, unless
|
||||
@--no-elide@ is in effect.
|
||||
@--no-elide@ is in effect.
|
||||
|
||||
* An account with a zero inclusive balance and less than two interesting
|
||||
subaccounts is not displayed at all, unless @--empty@ is in effect.
|
||||
@ -405,7 +405,7 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, colto
|
||||
([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
|
||||
trimborder $ lines $
|
||||
render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $
|
||||
addtotalrow $
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map (Header . padright acctswidth) accts)
|
||||
(T.Group NoLine $ map Header colspans)
|
||||
@ -426,7 +426,7 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, colto
|
||||
([printf "Ending balances (historical) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
|
||||
trimborder $ lines $
|
||||
render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $
|
||||
addtotalrow $
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map (Header . padright acctswidth) accts)
|
||||
(T.Group NoLine $ map Header colspans)
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-|
|
||||
{-|
|
||||
|
||||
Print a histogram report. (The "activity" command).
|
||||
|
||||
|
||||
@ -21,7 +21,7 @@ module Hledger.Cli.Options (
|
||||
argsFlag,
|
||||
showModeHelp,
|
||||
withAliases,
|
||||
|
||||
|
||||
-- * CLI options
|
||||
CliOpts(..),
|
||||
defcliopts,
|
||||
@ -51,9 +51,9 @@ module Hledger.Cli.Options (
|
||||
-- * Tests
|
||||
tests_Hledger_Cli_Options
|
||||
|
||||
)
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
import qualified Control.Exception as C
|
||||
import Control.Monad (when)
|
||||
import Data.List
|
||||
@ -199,7 +199,7 @@ standardAddonsHelp = [
|
||||
|
||||
-- | Get a mode's help message as a nicely wrapped string.
|
||||
showModeHelp :: Mode a -> String
|
||||
showModeHelp = (showText defaultWrap :: [Text] -> String) .
|
||||
showModeHelp = (showText defaultWrap :: [Text] -> String) .
|
||||
(helpText [] HelpFormatDefault :: Mode a -> [Text])
|
||||
|
||||
-- | Add command aliases to the command's help string.
|
||||
@ -275,7 +275,7 @@ rawOptsToCliOpts rawopts = do
|
||||
,width_ = maybestringopt "width" rawopts -- register
|
||||
,reportopts_ = ropts
|
||||
}
|
||||
|
||||
|
||||
-- | Do final validation of processed opts, raising an error if there is trouble.
|
||||
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
|
||||
checkCliOpts opts@CliOpts{reportopts_=ropts} = do
|
||||
@ -362,7 +362,7 @@ defaultBalanceFormat = [
|
||||
|
||||
-- | Output width configuration (for register).
|
||||
data OutputWidth =
|
||||
TotalWidth Width -- ^ specify the overall width
|
||||
TotalWidth Width -- ^ specify the overall width
|
||||
| FieldWidths [Width] -- ^ specify each field's width
|
||||
deriving Show
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-|
|
||||
{-|
|
||||
|
||||
A ledger-compatible @print@ command.
|
||||
|
||||
@ -46,7 +46,7 @@ entriesReportAsText _ _ items = concatMap showTransactionUnelided items
|
||||
-- "showTransactions" ~: do
|
||||
|
||||
-- -- "print expenses" ~:
|
||||
-- do
|
||||
-- do
|
||||
-- let opts = defreportopts{query_="expenses"}
|
||||
-- d <- getCurrentDay
|
||||
-- showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines
|
||||
@ -58,7 +58,7 @@ entriesReportAsText _ _ items = concatMap showTransactionUnelided items
|
||||
-- ]
|
||||
|
||||
-- -- , "print report with depth arg" ~:
|
||||
-- do
|
||||
-- do
|
||||
-- let opts = defreportopts{depth_=Just 2}
|
||||
-- d <- getCurrentDay
|
||||
-- showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-|
|
||||
{-|
|
||||
|
||||
A ledger-compatible @register@ command.
|
||||
|
||||
@ -75,7 +75,7 @@ postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =
|
||||
date desc acct amtfirstline balfirstline]
|
||||
++
|
||||
[printf (spacer ++ "%"++amtw++"s %"++balw++"s") a b | (a,b) <- zip amtrest balrest ]
|
||||
|
||||
|
||||
where
|
||||
totalwidth = case widthFromOpts opts of
|
||||
Left _ -> defaultWidth -- shouldn't happen
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
{-
|
||||
{-
|
||||
generateledger.hs NUMTXNS NUMACCTS ACCTDEPTH
|
||||
|
||||
Outputs a dummy ledger file with the specified number of transactions,
|
||||
|
||||
@ -43,7 +43,7 @@ allDeps base mod = allDeps' [mod] [mod] where
|
||||
allDeps' [] _ = return []
|
||||
|
||||
{-
|
||||
Usage: OrderByComplexity
|
||||
Usage: OrderByComplexity
|
||||
|
||||
= directory where source code is found. This MUST
|
||||
end in '/'
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
{-
|
||||
{-
|
||||
bench.hs - simple benchmarking of command-line programs.
|
||||
Requires html and tabular.
|
||||
Simon Michael 2008-2013
|
||||
@ -63,14 +63,14 @@ usagehdr = "bench [-f testsfile] [-n iterations] [-p precision] executable1 [exe
|
||||
"Run some functional tests with each of the specified executables,\n" ++
|
||||
"where a test is \"zero or more arguments supported by all executables\",\n" ++
|
||||
"and report the best execution times.\n"
|
||||
|
||||
|
||||
options = [
|
||||
Option "f" ["testsfile"] (ReqArg File "testsfile") "file containing tests, one per line, default: bench.tests"
|
||||
,Option "n" ["iterations"] (ReqArg Num "iterations") "number of test iterations to run, default: 2"
|
||||
,Option "p" ["precision"] (ReqArg Prec "precision") "show times with this precision, default: 2"
|
||||
,Option "v" ["verbose"] (NoArg Verbose) "show intermediate results"
|
||||
,Option "h" ["help"] (NoArg Help) "show this help"
|
||||
]
|
||||
]
|
||||
|
||||
usageftr = "\n" ++
|
||||
"Tips:\n" ++
|
||||
@ -81,10 +81,10 @@ usageftr = "\n" ++
|
||||
usage = usageInfo usagehdr options ++ usageftr
|
||||
|
||||
-- an option value
|
||||
data Opt = File {value::String}
|
||||
| Num {value::String}
|
||||
| Prec {value::String}
|
||||
-- I don't know how optValuesForConstructor etc. can have that
|
||||
data Opt = File {value::String}
|
||||
| Num {value::String}
|
||||
| Prec {value::String}
|
||||
-- I don't know how optValuesForConstructor etc. can have that
|
||||
-- type signature with these, but it works..
|
||||
-- | Some Int
|
||||
| Verbose
|
||||
@ -112,7 +112,7 @@ parseargs as =
|
||||
(_,_,errs) -> error (concat errs ++ usage)
|
||||
|
||||
optValueWithDefault :: (String -> Opt) -> String -> [Opt] -> String
|
||||
optValueWithDefault optcons def opts =
|
||||
optValueWithDefault optcons def opts =
|
||||
last $ def : optValuesForConstructor optcons opts
|
||||
|
||||
optValuesForConstructor :: (String -> Opt) -> [Opt] -> [String]
|
||||
@ -127,13 +127,13 @@ main = do
|
||||
tests <- liftM (filter istest . lines) (readFile file)
|
||||
now <- getCurrentTime
|
||||
putStrLn $ printf "Using %s" file
|
||||
putStrLn $ printf "Running %d tests %d times with %d executables at %s:"
|
||||
putStrLn $ printf "Running %d tests %d times with %d executables at %s:"
|
||||
(length tests) num (length exes) (show now)
|
||||
let doexe t e = mapM (doiteration opts t e) [1..num]
|
||||
let dotest t = mapM (doexe t) exes
|
||||
hSetBuffering stdout NoBuffering
|
||||
results <- mapM dotest tests
|
||||
summarise opts tests exes results
|
||||
summarise opts tests exes results
|
||||
|
||||
istest s = not (null s' || ("#" `isPrefixOf` s')) where s' = clean s
|
||||
clean = unwords . words
|
||||
|
||||
@ -9,7 +9,7 @@ import System.Environment
|
||||
import Text.Printf
|
||||
|
||||
main = do
|
||||
args <- getArgs
|
||||
args <- getArgs
|
||||
let f = head args
|
||||
s <- readFile f
|
||||
let ls = lines s
|
||||
|
||||
Loading…
Reference in New Issue
Block a user