fix warnings all over - hledger is now -W-clean

Commands/Add.hs

@@ -21,7 +21,7 @@ import Utils (ledgerFromStringWithOpts)
 -- and append them to the ledger file. If the ledger came from stdin, this
 -- command has no effect.
 add :: [Opt] -> [String] -> Ledger -> IO ()
-add opts args l
+add _ args l
     | filepath (rawledger l) == "-" = return ()
     | otherwise = do
   hPutStrLn stderr
@@ -90,7 +90,6 @@ getPostings historicalps enteredps = do
       getPostings historicalps $ enteredps ++ [p]
     where
       n = length enteredps + 1
-      realn = length enteredrealps + 1
       enteredrealps = filter isReal enteredps
       bestmatch | isNothing historicalps = Nothing
                 | n <= length ps = Just $ ps !! (n-1)
@@ -164,8 +163,8 @@ registerFromString s = do
 -- with a modification for short strings.
 compareStrings :: String -> String -> Float
 compareStrings "" "" = 1
-compareStrings (a:[]) "" = 0
+compareStrings (_:[]) "" = 0
-compareStrings "" (b:[]) = 0
+compareStrings "" (_:[]) = 0
 compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0
 compareStrings s1 s2 = 2.0 * (fromIntegral i) / (fromIntegral u)
     where

Commands/Balance.hs

@@ -103,9 +103,7 @@ import Ledger.Amount
 import Ledger.AccountName
 import Ledger.Transaction
 import Ledger.Ledger
-import Ledger.Parse
 import Options
-import Utils
 import System.IO.UTF8
 
 
@@ -115,7 +113,7 @@ balance opts args l = putStr $ showBalanceReport opts args l
 
 -- | Generate a balance report with the specified options for this ledger.
 showBalanceReport :: [Opt] -> [String] -> Ledger -> String
-showBalanceReport opts args l = acctsstr ++ totalstr
+showBalanceReport opts _ l = acctsstr ++ totalstr
     where 
       acctsstr = unlines $ map showacct interestingaccts
           where

Commands/Convert.hs

@@ -37,14 +37,12 @@ optional rule saving.
 -}
 
 module Commands.Convert where
-import Data.Maybe (isJust)
 import Data.List.Split (splitOn)
 import Options -- (Opt,Debug)
 import Ledger.Types (Ledger,AccountName)
 import Ledger.Utils (strip)
-import System (getArgs)
 import System.IO (stderr, hPutStrLn)
-import Text.CSV (parseCSVFromFile, Record)
+import Text.CSV (parseCSVFromFile)
 import Text.Printf (printf)
 import Text.RegexPR (matchRegexPR)
 import Data.Maybe
@@ -55,7 +53,7 @@ import Control.Monad (when)
 
 
 convert :: [Opt] -> [String] -> Ledger -> IO ()
-convert opts args l = do
+convert opts args _ = do
   when (length args /= 3) (error "please specify a csv file, base account, and import rules file.")
   let [csvfile,baseacct,rulesfile] = args
   rulesstr <- readFile rulesfile
@@ -83,10 +81,11 @@ parseRules s = do
 parsePatRepl :: String -> (String, Maybe String)
 parsePatRepl l = case splitOn "=" l of
                    (p:r:_) -> (p, Just r)
-                   (p:_)   -> (p, Nothing)
+                   _       -> (l, Nothing)
 
-print_ledger_txn debug (baseacct,fieldpositions,rules) record@(a:b:c:d:e) = do
+print_ledger_txn :: Bool -> (String,[Int],[Rule]) -> [String] -> IO ()
-  let [date,cleared,number,description,amount] = map (record !!) fieldpositions
+print_ledger_txn debug (baseacct,fieldpositions,rules) record@(_:_:_:_:_:[]) = do
+  let [date,_,number,description,amount] = map (record !!) fieldpositions
       amount' = strnegate amount where strnegate ('-':s) = s
                                        strnegate s = '-':s
       unknownacct | (read amount' :: Double) < 0 = "income:unknown"

Commands/Histogram.hs

@@ -7,8 +7,6 @@ Print a histogram report.
 module Commands.Histogram
 where
 import Prelude hiding (putStr)
-import qualified Data.Map as Map
-import Data.Map ((!))
 import Ledger
 import Options
 import System.IO.UTF8

Commands/Register.hs

@@ -7,8 +7,6 @@ A ledger-compatible @register@ command.
 module Commands.Register
 where
 import Prelude hiding (putStr)
-import qualified Data.Map as Map
-import Data.Map ((!))
 import Ledger
 import Options
 import System.IO.UTF8
@@ -46,7 +44,7 @@ showRegisterReport opts args l
       startbal = sumTransactions precedingts
       matchapats t = matchpats apats $ taccount t
       (apats,_) = parsePatternArgs args
-      matchdisplayopt Nothing t = True
+      matchdisplayopt Nothing _ = True
       matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
       dopt = displayFromOpts opts
       empty = Empty `elem` opts
@@ -99,7 +97,7 @@ clipAccountNames d as = nub $ map (clip d) as
 -- | Show transactions one per line, with each date/description appearing
 -- only once, and a running balance.
 showtxns [] _ _ = ""
-showtxns (t@Transaction{tamount=a}:ts) tprev bal = this ++ showtxns ts t bal'
+showtxns (t:ts) tprev bal = this ++ showtxns ts t bal'
     where
       this = showtxn (t `issame` tprev) t bal'
       issame t1 t2 = tnum t1 == tnum t2

Commands/Stats.hs

@@ -7,12 +7,9 @@ Print some statistics for the ledger.
 module Commands.Stats
 where
 import Prelude hiding (putStr)
-import qualified Data.Map as Map
-import Data.Map ((!))
 import Ledger
 import Options
 import System.IO.UTF8
-import Utils (filterAndCacheLedgerWithOpts)
 
 
 -- | Print various statistics for the ledger.
@@ -22,7 +19,7 @@ stats opts args l = do
   putStr $ showStats opts args l today
 
 showStats :: [Opt] -> [String] -> Ledger -> Day -> String
-showStats opts args l today = 
+showStats _ _ l today = 
     heading ++ (unlines $ map (\(a,b) -> printf fmt a b) stats)
     where
       heading = underline $ printf "Ledger statistics as of %s" (show today)

Commands/UI.hs

@@ -6,8 +6,6 @@ A simple text UI for hledger, based on the vty library.
 
 module Commands.UI
 where
-import qualified Data.Map as Map
-import Data.Map ((!))
 import Graphics.Vty
 import qualified Data.ByteString.Char8 as B
 import Ledger
@@ -19,7 +17,7 @@ import Commands.Print
 
 helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"
 
-instance Show Vty where show v = "a Vty"
+instance Show Vty where show = const "a Vty"
 
 -- | The application state when running the ui command.
 data AppState = AppState {
@@ -46,7 +44,7 @@ data Loc = Loc {
 data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts
             | RegisterScreen    -- ^ like hledger register, shows transaction-postings
             | PrintScreen       -- ^ like hledger print, shows ledger transactions
-            | LedgerScreen      -- ^ shows the raw ledger
+            -- | LedgerScreen      -- ^ shows the raw ledger
               deriving (Eq,Show)
 
 -- | Run the interactive text ui.
@@ -71,7 +69,7 @@ ui opts args l = do
 
 -- | Update the screen, wait for the next event, repeat.
 go :: AppState -> IO ()
-go a@AppState{av=av,aw=aw,ah=ah,abuf=buf,amsg=amsg,aopts=opts,aargs=args,aledger=l} = do
+go a@AppState{av=av,aw=_,ah=_,abuf=_,amsg=_,aopts=opts,aargs=_,aledger=_} = do
   when (not $ DebugNoUI `elem` opts) $ update av (renderScreen a)
   k <- getEvent av
   case k of 
@@ -100,9 +98,6 @@ go a@AppState{av=av,aw=aw,ah=ah,abuf=buf,amsg=amsg,aopts=opts,aargs=args,aledger
     EvKey (KASCII 'q') []       -> shutdown av >> return ()
 --    EvKey KEsc   []           -> shutdown av >> return ()
     _                           -> go a
-    where
-      bh = length buf
-      y = posY a
 
 -- app state modifiers
 
@@ -120,8 +115,13 @@ scrollY = sy . loc
 posY a = scrollY a + cursorY a
 
 setCursorY, setScrollY, setPosY :: Int -> AppState -> AppState
+setCursorY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings
 setCursorY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocCursorY y l
+
+setScrollY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings
 setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocScrollY y l
+
+setPosY _ AppState{alocs=[]}    = error "shouldn't happen" -- silence warnings
 setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}
     where 
       l' = setLocScrollY sy $ setLocCursorY cy l
@@ -129,6 +129,7 @@ setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}
       cy = y `mod` ph
       sy = y - cy
 
+
 updateCursorY, updateScrollY, updatePosY :: (Int -> Int) -> AppState -> AppState
 updateCursorY f a = setCursorY (f $ cursorY a) a
 updateScrollY f a = setScrollY (f $ scrollY a) a
@@ -147,17 +148,19 @@ moveToBottom :: AppState -> AppState
 moveToBottom a = setPosY (length $ abuf a) a
 
 moveUpAndPushEdge :: AppState -> AppState
-moveUpAndPushEdge a@AppState{alocs=(Loc{sy=sy,cy=cy}:_)}
+moveUpAndPushEdge a
     | cy > 0 = updateCursorY (subtract 1) a
     | sy > 0 = updateScrollY (subtract 1) a
     | otherwise = a
+    where Loc{sy=sy,cy=cy} = head $ alocs a
 
 moveDownAndPushEdge :: AppState -> AppState
-moveDownAndPushEdge a@AppState{alocs=(Loc{sy=sy,cy=cy}:_)}
+moveDownAndPushEdge a
     | sy+cy >= bh = a
     | cy < ph-1 = updateCursorY (+1) a
     | otherwise = updateScrollY (+1) a
     where 
+      Loc{sy=sy,cy=cy} = head $ alocs a
       ph = pageHeight a
       bh = length $ abuf a
 
@@ -178,7 +181,7 @@ nextpage (a@AppState{abuf=b})
 -- without moving the cursor, or if we are scrolled as far as possible
 -- then move the cursor to the first line.
 prevpage :: AppState -> AppState
-prevpage (a@AppState{abuf=b})
+prevpage a
     | sy > 0    = setScrollY sy' a
     | otherwise = setCursorY 0 a
     where
@@ -212,31 +215,30 @@ enter :: Screen -> AppState -> AppState
 enter scr@BalanceScreen a  = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
 enter scr@RegisterScreen a = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
 enter scr@PrintScreen a    = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
-enter scr@LedgerScreen a   = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
+-- enter scr@LedgerScreen a   = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
 
 resetTrailAndEnter scr a = enter scr $ clearLocs a
 
 -- | Regenerate the display data appropriate for the current screen.
 updateData :: AppState -> AppState
-updateData a@AppState{aopts=opts,aargs=args,aledger=l}
+updateData a@AppState{aopts=opts,aargs=args,aledger=l} =
-    | scr == BalanceScreen  = a{abuf=lines $ showBalanceReport opts [] l, aargs=[]}
+    case screen a of
-    | scr == RegisterScreen = a{abuf=lines $ showRegisterReport opts args l}
+      BalanceScreen  -> a{abuf=lines $ showBalanceReport opts [] l, aargs=[]}
-    | scr == PrintScreen    = a{abuf=lines $ showLedgerTransactions opts args l}
+      RegisterScreen -> a{abuf=lines $ showRegisterReport opts args l}
-    | scr == LedgerScreen   = a{abuf=lines $ rawledgertext l}
+      PrintScreen    -> a{abuf=lines $ showLedgerTransactions opts args l}
-    where scr = screen a
+      -- LedgerScreen   -> a{abuf=lines $ rawledgertext l}
 
 backout :: AppState -> AppState
-backout a
+backout a | screen a == BalanceScreen = a
-    | screen a == BalanceScreen = a
+          | otherwise = updateData $ popLoc a
-    | otherwise = updateData $ popLoc a
 
 drilldown :: AppState -> AppState
-drilldown a
+drilldown a =
-    | screen a == BalanceScreen  = enter RegisterScreen a{aargs=[currentAccountName a]}
+    case screen a of
-    | screen a == RegisterScreen = scrollToLedgerTransaction e $ enter PrintScreen a
+      BalanceScreen  -> enter RegisterScreen a{aargs=[currentAccountName a]}
-    | screen a == PrintScreen   = a
+      RegisterScreen -> scrollToLedgerTransaction e $ enter PrintScreen a
-    -- screen a == PrintScreen   = enter LedgerScreen a
+      PrintScreen   -> a
-    -- screen a == LedgerScreen   = a
+      -- LedgerScreen   -> a{abuf=lines $ rawledgertext l}
     where e = currentLedgerTransaction a
 
 -- | Get the account name currently highlighted by the cursor on the
@@ -350,28 +352,26 @@ renderStatus w s = renderBS statusattr (B.pack $ take w (s ++ repeat ' '))
 
 -- the all-important theming engine
 
-theme = 1
+theme = Restrained
+
+data UITheme = Restrained | Colorful | Blood
 
 (defaultattr, 
  currentlineattr, 
  statusattr
- ) = 
+ ) = case theme of
-    case theme of
+       Restrained -> (attr
-      1 -> ( -- restrained
+                    ,setBold attr
-           attr
+                    ,setRV attr
-          ,setBold attr
+                    )
-          ,setRV attr
+       Colorful   -> (setRV attr
-          )
+                    ,setFG white $ setBG red $ attr
-      2 -> ( -- colorful
+                    ,setFG black $ setBG green $ attr
-           setRV attr
+                    )
-          ,setFG white $ setBG red $ attr
+       Blood      -> (setRV attr
-          ,setFG black $ setBG green $ attr
+                    ,setFG white $ setBG red $ attr
-          )
+                    ,setRV attr
-      3 -> ( -- 
+                    )
-           setRV attr
-          ,setFG white $ setBG red $ attr
-          ,setRV attr
-          )
 
 halfbrightattr = setHalfBright attr
 reverseattr = setRV attr

Commands/Web.hs

@@ -4,23 +4,13 @@ A happs-based web UI for hledger.
 
 module Commands.Web
 where
-import Control.Monad.Trans (liftIO)
-import Data.ByteString.Lazy.UTF8 (toString)
-import qualified Data.Map as M
--- import Data.Map ((!))
-import Data.Time.Clock
-import Data.Time.Format
-import Locale
 import Control.Concurrent
-import qualified Data.ByteString.Lazy.Char8 as B
-import Happstack.Data (defaultValue)
 import Happstack.Server
-import Happstack.Server.HTTP.FileServe (fileServe)
 import Happstack.State.Control (waitForTermination)
 import System.Cmd (system)
 import System.Info (os)
 import System.Exit
-import Network.HTTP (urlEncode, urlDecode, urlEncodeVars)
+import Network.HTTP (urlEncode, urlDecode)
 import Text.XHtml hiding (dir)
 
 import Ledger
@@ -122,7 +112,7 @@ searchform r a p' =
                 | otherwise = spaceHtml +++ anchor ! [href u] << stringToHtml "reset"
 
 navlinks :: Request -> String -> String -> Html
-navlinks r a p' = 
+navlinks _ a p' = 
     concatHtml $ intersperse sep $ map linkto ["balance", "register", "print", "histogram"]
     where
       sep = stringToHtml " | "

Ledger/AccountName.hs

@@ -10,7 +10,7 @@ module Ledger.AccountName
 where
 import Ledger.Utils
 import Ledger.Types
-import Data.Map ((!), fromList, Map)
+import Data.Map (Map)
 import qualified Data.Map as M
 
 

Ledger/Amount.hs

@@ -39,7 +39,6 @@ examples:
 
 module Ledger.Amount
 where
-import qualified Data.Map as Map
 import Ledger.Utils
 import Ledger.Types
 import Ledger.Commodity
@@ -77,13 +76,13 @@ negateAmountPreservingPrice a = (-a){price=price a}
 -- any price information. (Using the second commodity is best since sum
 -- and other folds start with a no-commodity amount.)
 amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
-amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) = 
+amountop op a@(Amount _ _ _) (Amount bc bq _) = 
     Amount bc ((quantity $ convertAmountTo bc a) `op` bq) Nothing
 
 -- | Convert an amount to the commodity of its saved price, if any.
 costOfAmount :: Amount -> Amount
 costOfAmount a@(Amount _ _ Nothing) = a
-costOfAmount a@(Amount _ q (Just price))
+costOfAmount (Amount _ q (Just price))
     | isZeroMixedAmount price = nullamt
     | otherwise = Amount pc (pq*q) Nothing
     where (Amount pc pq _) = head $ amounts price
@@ -91,15 +90,16 @@ costOfAmount a@(Amount _ q (Just price))
 -- | Convert an amount to the specified commodity using the appropriate
 -- exchange rate (which is currently always 1).
 convertAmountTo :: Commodity -> Amount -> Amount
-convertAmountTo c2 (Amount c1 q p) = Amount c2 (q * conversionRate c1 c2) Nothing
+convertAmountTo c2 (Amount c1 q _) = Amount c2 (q * conversionRate c1 c2) Nothing
 
 -- | Get the string representation of an amount, based on its commodity's
 -- display settings.
 showAmount :: Amount -> String
-showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) q pri)
+showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message
-    | sym=="AUTO" = "" -- can display one of these in an error message
+showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) =
-    | side==L = printf "%s%s%s%s" sym space quantity price
+    case side of
-    | side==R = printf "%s%s%s%s" quantity space sym price
+      L -> printf "%s%s%s%s" sym space quantity price
+      R -> printf "%s%s%s%s" quantity space sym price
     where 
       space = if spaced then " " else ""
       quantity = showAmount' a

Ledger/Commodity.hs

@@ -8,7 +8,6 @@ are thousands separated by comma, significant decimal places and so on.
 -}
 module Ledger.Commodity
 where
-import qualified Data.Map as Map
 import Ledger.Utils
 import Ledger.Types
 
@@ -36,5 +35,5 @@ comm sym = fromMaybe
 
 -- | Find the conversion rate between two commodities. Currently returns 1.
 conversionRate :: Commodity -> Commodity -> Double
-conversionRate oldc newc = 1
+conversionRate _ _ = 1
 

Ledger/Dates.hs

@@ -19,16 +19,9 @@ quarterly, etc.
 module Ledger.Dates
 where
 
-import Data.Time.Clock
 import Data.Time.Format
-import Data.Time.Calendar
-import Data.Time.Calendar.MonthDay
 import Data.Time.Calendar.OrdinalDate
-import Data.Time.Calendar.WeekDate
-import Data.Time.LocalTime
 import Locale (defaultTimeLocale)
-import Text.Printf
-import Data.Maybe
 import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Char
 import Text.ParserCombinators.Parsec.Combinator
@@ -49,24 +42,29 @@ elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
 
 -- | Split a DateSpan into one or more consecutive spans at the specified interval.
 splitSpan :: Interval -> DateSpan -> [DateSpan]
-splitSpan i (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
+splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
 splitSpan NoInterval s = [s]
-splitSpan Daily s      = splitspan start next s where (start,next) = (startofday,nextday)
+splitSpan Daily s      = splitspan startofday     nextday     s
-splitSpan Weekly s     = splitspan start next s where (start,next) = (startofweek,nextweek)
+splitSpan Weekly s     = splitspan startofweek    nextweek    s
-splitSpan Monthly s    = splitspan start next s where (start,next) = (startofmonth,nextmonth)
+splitSpan Monthly s    = splitspan startofmonth   nextmonth   s
-splitSpan Quarterly s  = splitspan start next s where (start,next) = (startofquarter,nextquarter)
+splitSpan Quarterly s  = splitspan startofquarter nextquarter s
-splitSpan Yearly s     = splitspan start next s where (start,next) = (startofyear,nextyear)
+splitSpan Yearly s     = splitspan startofyear    nextyear    s
 
+splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
 splitspan _ _ (DateSpan Nothing Nothing) = []
-splitspan startof next (DateSpan Nothing (Just e)) = [DateSpan (Just $ startof e) (Just $ next $ startof e)]
+splitspan start next (DateSpan Nothing (Just e)) = [DateSpan (Just $ start e) (Just $ next $ start e)]
-splitspan startof next (DateSpan (Just b) Nothing) = [DateSpan (Just $ startof b) (Just $ next $ startof b)]
+splitspan start next (DateSpan (Just b) Nothing) = [DateSpan (Just $ start b) (Just $ next $ start b)]
-splitspan startof next s@(DateSpan (Just b) (Just e))
+splitspan start next span@(DateSpan (Just b) (Just e))
-    | b == e = [s]
+    | b == e = [span]
-    | otherwise = splitspan' startof next s
+    | otherwise = splitspan' start next span
-    where splitspan' startof next (DateSpan (Just b) (Just e))
+    where
-              | b >= e = []
+      splitspan' start next (DateSpan (Just b) (Just e))
-              | otherwise = [DateSpan (Just $ startof b) (Just $ next $ startof b)] 
+          | b >= e = []
-                            ++ splitspan' startof next (DateSpan (Just $ next $ startof b) (Just e))
+          | otherwise = [DateSpan (Just s) (Just n)]
+                        ++ splitspan' start next (DateSpan (Just n) (Just e))
+          where s = start b
+                n = next s
+      splitspan' _ _ _ = error "won't happen, avoids warnings"
 
 -- | Count the days in a DateSpan, or if it is open-ended return Nothing.
 daysInSpan :: DateSpan -> Maybe Integer
@@ -89,7 +87,7 @@ spanFromSmartDateString refdate s = spanFromSmartDate refdate sdate
 spanFromSmartDate :: Day -> SmartDate -> DateSpan
 spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
     where
-      (ry,rm,rd) = toGregorian refdate
+      (ry,rm,_) = toGregorian refdate
       (b,e) = span sdate
       span :: SmartDate -> (Day,Day)
       span ("","","today")       = (refdate, nextday refdate)

Ledger/IO.hs

@@ -5,8 +5,6 @@ Utilities for doing I/O with ledger files.
 module Ledger.IO
 where
 import Control.Monad.Error
-import Data.Time.Clock
-import Data.Time.LocalTime (LocalTime)
 import Ledger.Ledger (cacheLedger)
 import Ledger.Parse (parseLedger)
 import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger)
@@ -15,8 +13,6 @@ import Ledger.Utils (getCurrentLocalTime)
 import System.Directory (getHomeDirectory)
 import System.Environment (getEnv)
 import System.IO
-import Text.ParserCombinators.Parsec
-import qualified Data.Map as Map (lookup)
 import System.FilePath ((</>))
 
 
@@ -81,7 +77,6 @@ readLedger = readLedgerWithIOArgs noioargs
 -- | or give an error.
 readLedgerWithIOArgs :: IOArgs -> FilePath -> IO Ledger
 readLedgerWithIOArgs ioargs f = do
-  t <- getCurrentLocalTime
   s <- readFile f 
   rl <- rawLedgerFromString s
   return $ filterAndCacheLedger ioargs s rl

Ledger/Ledger.hs

@@ -57,12 +57,10 @@ import qualified Data.Map as Map
 import Data.Map ((!))
 import Ledger.Utils
 import Ledger.Types
-import Ledger.Amount
+import Ledger.Account ()
 import Ledger.AccountName
-import Ledger.Account
 import Ledger.Transaction
 import Ledger.RawLedger
-import Ledger.LedgerTransaction
 
 
 instance Show Ledger where

Ledger/LedgerTransaction.hs

@@ -57,15 +57,13 @@ showLedgerTransactionUnelided = showLedgerTransaction' False
 
 showLedgerTransaction' :: Bool -> LedgerTransaction -> String
 showLedgerTransaction' elide t = 
-    unlines $ [{-precedingcomment ++ -}description] ++ (showpostings $ ltpostings t) ++ [""]
+    unlines $ [description] ++ (showpostings $ ltpostings t) ++ [""]
     where
-      precedingcomment = ltpreceding_comment_lines t
       description = concat [date, status, code, desc] -- , comment]
       date = showdate $ ltdate t
       status = if ltstatus t then " *" else ""
       code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
       desc = " " ++ ltdescription t
-      comment = if (length $ ltcomment t) > 0 then "  ; "++(ltcomment t) else ""
       showdate d = printf "%-10s" (showDate d)
       showpostings ps
           | elide && length ps > 1 && isLedgerTransactionBalanced t

Ledger/Parse.hs

@@ -7,28 +7,19 @@ Parsers for standard ledger and timelog files.
 module Ledger.Parse
 where
 import Prelude hiding (readFile, putStr, print)
-import Control.Monad
 import Control.Monad.Error
 import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Char
-import Text.ParserCombinators.Parsec.Language
 import Text.ParserCombinators.Parsec.Combinator
-import qualified Text.ParserCombinators.Parsec.Token as P
 import System.Directory
 import System.IO.UTF8
 import System.IO (stdin)
-import qualified Data.Map as Map
-import Data.Time.LocalTime
-import Data.Time.Calendar
 import Ledger.Utils
 import Ledger.Types
 import Ledger.Dates
-import Ledger.AccountName
 import Ledger.Amount
 import Ledger.LedgerTransaction
 import Ledger.Posting
-import Ledger.Commodity
-import Ledger.TimeLog
 import Ledger.RawLedger
 import System.FilePath(takeDirectory,combine)
 
@@ -111,6 +102,7 @@ ledgerDirective = do char '!' <?> "directive"
                        "include" -> ledgerInclude
                        "account" -> ledgerAccountBegin
                        "end"     -> ledgerAccountEnd
+                       _         -> mzero
 
 ledgerInclude :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
 ledgerInclude = do many1 spacenonewline
@@ -291,9 +283,9 @@ ledgerHistoricalPrice = do
   many spacenonewline
   symbol1 <- commoditysymbol
   many spacenonewline
-  (Mixed [Amount c price pri]) <- someamount
+  (Mixed [Amount c q _]) <- someamount
   restofline
-  return $ HistoricalPrice date symbol1 (symbol c) price
+  return $ HistoricalPrice date symbol1 (symbol c) q
 
 -- like ledgerAccountBegin, updates the LedgerFileCtx
 ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
@@ -373,7 +365,6 @@ ledgerposting = do
   many spacenonewline
   comment <- ledgercomment
   restofline
-  parent <- getParentAccount
   return (Posting status account' amount comment ptype)
 
 -- Qualify with the parent account from parsing context
@@ -542,16 +533,16 @@ datedisplayexpr = do
   char '['
   (y,m,d) <- smartdate
   char ']'
-  let ltdate = parsedate $ printf "%04s/%02s/%02s" y m d
+  let date    = parsedate $ printf "%04s/%02s/%02s" y m d
-  let matcher = \(Transaction{tdate=d}) -> 
+      test op = return $ (`op` date) . tdate
-                  case op of
+  case op of
-                    "<"  -> d <  ltdate
+    "<"  -> test (<)
-                    "<=" -> d <= ltdate
+    "<=" -> test (<=)
-                    "="  -> d == ltdate
+    "="  -> test (==)
-                    "==" -> d == ltdate -- just in case
+    "==" -> test (==)
-                    ">=" -> d >= ltdate
+    ">=" -> test (>=)
-                    ">"  -> d >  ltdate
+    ">"  -> test (>)
-  return matcher              
+    _    -> mzero
 
 compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
 

Ledger/Posting.hs

@@ -22,14 +22,14 @@ instance Show Posting where show = showPosting
 nullrawposting = Posting False "" nullmixedamt "" RegularPosting
 
 showPosting :: Posting -> String
-showPosting (Posting s a amt _ ttype) = 
+showPosting (Posting _ a amt _ ttype) = 
     concatTopPadded [showaccountname a ++ " ", showamount amt]
     where
       showaccountname = printf "%-22s" . bracket . elideAccountName width
       (bracket,width) = case ttype of
-                      BalancedVirtualPosting -> (\s -> "["++s++"]", 20)
+                          BalancedVirtualPosting -> (\s -> "["++s++"]", 20)
-                      VirtualPosting -> (\s -> "("++s++")", 20)
+                          VirtualPosting -> (\s -> "("++s++")", 20)
-                      otherwise -> (id,22)
+                          _ -> (id,22)
       showamount = padleft 12 . showMixedAmountOrZero
 
 isReal :: Posting -> Bool

Ledger/RawLedger.hs

@@ -13,7 +13,6 @@ import Ledger.Utils
 import Ledger.Types
 import Ledger.AccountName
 import Ledger.Amount
-import Ledger.LedgerTransaction
 import Ledger.Transaction
 import Ledger.Posting
 import Ledger.TimeLog

Ledger/TimeLog.hs

@@ -12,7 +12,6 @@ import Ledger.Utils
 import Ledger.Types
 import Ledger.Dates
 import Ledger.Commodity
-import Ledger.Amount
 import Ledger.LedgerTransaction
 
 instance Show TimeLogEntry where 
@@ -82,7 +81,6 @@ entryFromTimeLogInOut i o
       itod     = localTimeOfDay itime
       otod     = localTimeOfDay otime
       idate    = localDay itime
-      odate    = localDay otime
       hrs      = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
       amount   = Mixed [hours hrs]
       ps       = [Posting False acctname amount "" RegularPosting

Ledger/Transaction.hs

@@ -15,14 +15,13 @@ import Ledger.Utils
 import Ledger.Types
 import Ledger.Dates
 import Ledger.LedgerTransaction (showAccountName)
-import Ledger.Posting
 import Ledger.Amount
 
 
 instance Show Transaction where show=showTransaction
 
 showTransaction :: Transaction -> String
-showTransaction (Transaction eno stat d desc a amt ttype) = 
+showTransaction (Transaction _ stat d desc a amt ttype) = 
     s ++ unwords [showDate d,desc,a',show amt,show ttype]
     where s = if stat then " *" else ""
           a' = showAccountName Nothing ttype a

Ledger/Utils.hs

@@ -150,7 +150,7 @@ difforzero a b = maximum [(a - b), 0]
 containsRegex :: String -> String -> Bool
 containsRegex r s = case matchRegexPR ("(?i)"++r) s of
                       Just _ -> True
-                      otherwise -> False
+                      _ -> False
 
 
 -- lists
@@ -184,7 +184,7 @@ subtreeat v t
 -- | get the sub-tree for the specified node value in the first tree in
 -- forest in which it occurs.
 subtreeinforest :: Eq a => a -> [Tree a] -> Maybe (Tree a)
-subtreeinforest v [] = Nothing
+subtreeinforest _ [] = Nothing
 subtreeinforest v (t:ts) = case (subtreeat v t) of
                              Just t' -> Just t'
                              Nothing -> subtreeinforest v ts

Options.hs

@@ -5,15 +5,9 @@ Command-line options for the application.
 
 module Options 
 where
-import System
 import System.Console.GetOpt
 import System.Environment
-import Text.Printf
+import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath)
-import Data.Char (toLower)
-import Ledger.IO (IOArgs,
-                  ledgerenvvar,myLedgerPath,
-                  timelogenvvar,myTimelogPath)
-import Ledger.Parse
 import Ledger.Utils
 import Ledger.Types
 import Ledger.Dates
@@ -176,19 +170,17 @@ dateSpanFromOpts refdate opts
 -- | Figure out the reporting interval, if any, specified by the options.
 -- If there is a period option, the others are ignored.
 intervalFromOpts :: [Opt] -> Interval
-intervalFromOpts opts
+intervalFromOpts opts =
-    | not $ null popts = fst $ parsePeriodExpr refdate $ last popts
+    case (periodopts, intervalopts) of
-    | null otheropts = NoInterval
+      ((p:_), _)            -> fst $ parsePeriodExpr d p where d = parsedate "0001/01/01" -- unused
-    | otherwise = case last otheropts of
+      (_, (WeeklyOpt:_))    -> Weekly
-                    WeeklyOpt  -> Weekly
+      (_, (MonthlyOpt:_))   -> Monthly
-                    MonthlyOpt -> Monthly
+      (_, (QuarterlyOpt:_)) -> Quarterly
-                    QuarterlyOpt -> Quarterly
+      (_, (YearlyOpt:_))    -> Yearly
-                    YearlyOpt  -> Yearly
+      (_, _)                -> NoInterval
     where
-      popts = optValuesForConstructor Period opts
+      periodopts   = reverse $ optValuesForConstructor Period opts
-      otheropts = filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
+      intervalopts = reverse $ filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
-      -- doesn't affect the interval, but parsePeriodExpr needs something
-      refdate = parsedate "0001/01/01"
 
 -- | Get the value of the (last) depth option, if any, otherwise a large number.
 depthFromOpts :: [Opt] -> Int

Tests.hs

@@ -171,8 +171,7 @@ import qualified Data.Map as Map
 import Data.Time.Format
 import Locale (defaultTimeLocale)
 import Text.ParserCombinators.Parsec
-import Test.HUnit
+import Test.HUnit.Tools (runVerboseTests)
-import Test.HUnit.Tools (assertRaises, runVerboseTests)
 
 import Commands.All
 import Ledger
@@ -180,12 +179,12 @@ import Options
 import Utils
 
 
-runtests opts args = runner flattests
+runtests opts args = runner ts
     where
       runner | (Verbose `elem` opts) = runVerboseTests
              | otherwise = \t -> runTestTT t >>= return . (flip (,) 0)
-      flattests = TestList $ filter matchname $ concatMap tflatten tests
+      ts = TestList $ filter matchname $ concatMap tflatten tests
-      deeptests = tfilter matchname $ TestList tests
+      --ts = tfilter matchname $ TestList tests -- unflattened
       matchname = matchpats args . tname
 
 -- | Get a Test's label, or the empty string.
@@ -482,7 +481,6 @@ tests = [
          nowstr = showtime now
          yesterday = prevday today
          clockin t a = TimeLogEntry In t a
-         clockout t = TimeLogEntry Out t ""
          mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s
          showtime t = formatTime defaultTimeLocale "%H:%M" t
          assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es)
@@ -582,7 +580,6 @@ tests = [
     return ()
 
   ,"ledgerFile" ~: do
-    let now = getCurrentLocalTime
     assertBool "ledgerFile should parse an empty file" $ (isRight $ parseWithCtx 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

Utils.hs

@@ -8,13 +8,10 @@ Utilities for top-level modules and ghci. See also "Ledger.IO" and
 module Utils
 where
 import Control.Monad.Error
-import Data.Time.Clock
 import Ledger
 import Options (Opt,ledgerFilePathFromOpts,optsToIOArgs)
 import System.Directory (doesFileExist)
 import System.IO
-import Text.ParserCombinators.Parsec
-import qualified Data.Map as Map (lookup)
 
 
 -- | Parse the user's specified ledger file and run a hledger command on

Version.hs

@@ -42,6 +42,8 @@ binaryfilename = prettify $ splitAtElement '.' buildversion :: String
                   prettify (major:minor:bugfix:[]) = prettify (major:minor:bugfix:"0":[])
                   prettify (major:minor:[])        = prettify (major:minor:"0":"0":[])
                   prettify (major:[])              = prettify (major:"0":"0":"0":[])
+                  prettify []                      = error "VERSION is empty, please fix"
+                  prettify _                       = error "VERSION has too many components, please fix"
 
 versionstr    = prettify $ splitAtElement '.' buildversion :: String
                 where

hledger.hs

@@ -36,11 +36,8 @@ See "Ledger.Ledger" for more examples.
 -}
 
 module Main where
-import Control.Monad.Error
 import Prelude hiding (putStr, putStrLn)
-import System.IO (stderr)
 import System.IO.UTF8
-import qualified Data.Map as Map (lookup)
 
 import Commands.All
 import Ledger