move commands to their own subpackage

Commands/Add.hs

@@ -4,12 +4,12 @@ An add command to help with data entry.
 
 -}
 
-module AddCommand
+module Commands.Add
 where
 import Prelude hiding (putStr, putStrLn, getLine, appendFile)
 import Ledger
 import Options
-import RegisterCommand (showRegisterReport)
+import Commands.Register (showRegisterReport)
 import System.IO.UTF8
 import System.IO (stderr, hFlush)
 import System.IO.Error

Commands/All.hs

@@ -0,0 +1,37 @@
+{-# OPTIONS_GHC -cpp #-}
+{-| 
+
+This module re-exports all the Commands modules. It's just a convenience,
+you can import individual modules if you prefer.
+
+-}
+
+module Commands.All (
+                     module Commands.Add,
+                     module Commands.Balance,
+                     module Commands.Convert,
+                     module Commands.Histogram,
+                     module Commands.Print,
+                     module Commands.Register,
+                     module Commands.Stats,
+#ifdef VTY
+                     module Commands.UI,
+#endif
+#ifdef HAPPS
+                     module Commands.Web,
+#endif
+              )
+where
+import Commands.Add
+import Commands.Balance
+import Commands.Convert
+import Commands.Histogram
+import Commands.Print
+import Commands.Register
+import Commands.Stats
+#ifdef VTY
+import Commands.UI
+#endif
+#ifdef HAPPS
+import Commands.Web
+#endif

Commands/Balance.hs

@@ -94,7 +94,7 @@ balance report:
 
 -}
 
-module BalanceCommand
+module Commands.Balance
 where
 import Prelude hiding (putStr)
 import Ledger.Utils

Commands/Convert.hs

@@ -36,7 +36,7 @@ optional rule saving.
 
 -}
 
-module ConvertCommand where
+module Commands.Convert where
 import Data.Maybe (isJust)
 import Data.List.Split (splitOn)
 import Options -- (Opt,Debug)

Commands/Histogram.hs

@@ -4,7 +4,7 @@ Print a histogram report.
 
 -}
 
-module HistogramCommand
+module Commands.Histogram
 where
 import Prelude hiding (putStr)
 import qualified Data.Map as Map
@@ -30,7 +30,7 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns
       fullspan = rawLedgerDateSpan $ rawledger l
       days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
       daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]
-      -- same as RegisterCommand
+      -- same as Register
       ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
       filterempties
           | Empty `elem` opts = id

Commands/Print.hs

@@ -4,7 +4,7 @@ A ledger-compatible @print@ command.
 
 -}
 
-module PrintCommand
+module Commands.Print
 where
 import Prelude hiding (putStr)
 import Ledger

Commands/Register.hs

@@ -4,7 +4,7 @@ A ledger-compatible @register@ command.
 
 -}
 
-module RegisterCommand
+module Commands.Register
 where
 import Prelude hiding (putStr)
 import qualified Data.Map as Map

Commands/Stats.hs

@@ -4,7 +4,7 @@ Print some statistics for the ledger.
 
 -}
 
-module StatsCommand
+module Commands.Stats
 where
 import Prelude hiding (putStr)
 import qualified Data.Map as Map

Commands/UI.hs

@@ -4,7 +4,7 @@ A simple text UI for hledger, based on the vty library.
 
 -}
 
-module UICommand
+module Commands.UI
 where
 import qualified Data.Map as Map
 import Data.Map ((!))
@@ -12,9 +12,9 @@ import Graphics.Vty
 import qualified Data.ByteString.Char8 as B
 import Ledger
 import Options
-import BalanceCommand
-import RegisterCommand
-import PrintCommand
+import Commands.Balance
+import Commands.Register
+import Commands.Print
 
 
 helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"

Commands/Web.hs

@@ -2,7 +2,7 @@
 A happs-based web UI for hledger.
 -}
 
-module WebCommand
+module Commands.Web
 where
 import Control.Monad.Trans (liftIO)
 import Data.ByteString.Lazy.UTF8 (toString)
@@ -21,13 +21,14 @@ import System.Cmd (system)
 import System.Info (os)
 import System.Exit
 import Network.HTTP (urlEncode, urlDecode, urlEncodeVars)
+import Text.XHtml hiding (dir)
 
 import Ledger
 import Options
-import BalanceCommand
-import RegisterCommand
-import PrintCommand
-import HistogramCommand
+import Commands.Balance
+import Commands.Register
+import Commands.Print
+import Commands.Histogram
 import Utils (filterAndCacheLedgerWithOpts)
 
 
@@ -55,10 +56,10 @@ web opts args l = do
 webHandlers :: [Opt] -> [String] -> Ledger -> LocalTime -> ServerPartT IO Response
 webHandlers opts args l t = msum
  [
-  methodSP GET $ view showBalanceReport
- ,dir "balance" $ view showBalanceReport
- ,dir "register" $ view showRegisterReport
- ,dir "print" $ view showLedgerTransactions
+  methodSP GET    $ view showBalanceReport
+ ,dir "balance"   $ view showBalanceReport
+ ,dir "register"  $ view showRegisterReport
+ ,dir "print"     $ view showLedgerTransactions
  ,dir "histogram" $ view showHistogram
  ]
  where 
@@ -67,7 +68,7 @@ webHandlers opts args l t = msum
        where
          opts' = opts ++ [Period p]
          args' = args ++ (map urlDecode $ words a)
-         -- re-filter the full ledger
+         -- re-filter the full ledger with the new opts
          l' = filterAndCacheLedgerWithOpts opts' args' t (rawledgertext l) (rawledger l)
 
 rqdata = do
@@ -78,7 +79,7 @@ rqdata = do
 layout :: (String, String) -> String -> ServerPartT IO Response
 layout (a,p) s = do
   r <- askRq
-  return $ setHeader "Content-Type" "text/html" $ toResponse $ maintemplate (a,p) r s
+  return $ setHeader "Content-Type" "text/html" $ toResponse $ maintemplate' (a,p) r s
 
 maintemplate :: (String, String) -> Request -> String -> String
 maintemplate (a,p) r = printf (unlines
@@ -110,6 +111,44 @@ maintemplate (a,p) r = printf (unlines
       resetlink | null a && null p = ""
                 | otherwise = printf "&nbsp; <a href=%s>reset</a>" u
 
+maintemplate' :: (String, String) -> Request -> String -> String
+maintemplate' (a,period) r s = renderHtml $ 
+  body << concatHtml [
+            (thediv Text.XHtml.! [thestyle "float:right; text-align:right;"]) << noHtml,
+            pre << s
+           ]
+
+-- printf (unlines
+--   ["<div style=\"float:right;text-align:right;\">"
+--   ,"<form action=%s>"
+--   ,"&nbsp; filter by:&nbsp;<input name=a size=30 value=\"%s\">"
+--   ,"&nbsp; reporting period:&nbsp;<input name=p size=30 value=\"%s\">"
+--   ,resetlink
+--   ,"</form>"
+--   ,"</div>"
+--   ,"<div style=\"width:100%%; font-weight:bold;\">"
+--   ," <a href=balance%s>balance</a>"
+--   ,"|"
+--   ," <a href=register%s>register</a>"
+--   ,"|"
+--   ," <a href=print%s>print</a>"
+--   ,"|"
+--   ," <a href=histogram%s>histogram</a>"
+--   ,"</div>"
+--   ,"<pre>%s</pre>"
+--   ]) u a p q q q q
+--     where
+--       u = dropWhile (=='/') $ rqUri r
+--       -- another way to get them
+--       -- a = fromMaybe "" $ queryValue "a" r
+--       -- p = fromMaybe "" $ queryValue "p" r
+--       q' = intercalate "&" $
+--            (if null a then [] else [(("a="++).urlEncode) a]) ++ 
+--            (if null p then [] else [(("p="++).urlEncode) p])
+--       q = if null q' then "" else '?':q'
+--       resetlink | null a && null p = ""
+--                 | otherwise = printf "&nbsp; <a href=%s>reset</a>" u
+
 queryValues :: String -> Request -> [String]
 queryValues q r = map (B.unpack . inputValue . snd) $ filter ((==q).fst) $ rqInputs r
 

Makefile

@@ -1,5 +1,7 @@
 # hledger project makefile
 
+SOURCEFILES:=*hs Commands/*hs Ledger/*hs
+DOCFILES=HOME README NEWS CONTRIBUTORS SCREENSHOTS
 TIME:=`date +"%Y%m%d%H%M"`
 
 # patches since last release tag (as a haskell string literal)
@@ -14,6 +16,9 @@ BUILDFLAGS=-DPATCHES=$(PATCHES) $(OPTFLAGS)
 #CICMD=web --debug -BE
 CICMD=test
 
+# executables to benchtest, prepend ./ if not in $PATH.  
+BENCHEXES=hledger-0.4 hledger-0.5 ledger
+
 # command to run during profiling
 PROFCMD=-f 1000x1000x10.ledger balance
 
@@ -88,9 +93,7 @@ haddocktest:
 	@make --quiet haddock
 
 # run performance tests and save results in profs/. 
-# Requires some tests defined in bench.tests and some executables defined below.
-# Prepend ./ to these if not in $PATH.  
-BENCHEXES=hledger-0.4 hledger-0.5 ledger
+# Requires some tests defined in bench.tests and some executables defined above.
 benchtest: sampleledgers bench.tests bench
 	tools/bench -fbench.tests $(BENCHEXES) | tee profs/$(TIME).bench
 	@(cd profs; rm -f latest.bench; ln -s $(TIME).bench latest.bench)
@@ -127,19 +130,17 @@ sample.ledger:
 ######################################################################
 # DOCS
 
-DOCS=HOME README NEWS CONTRIBUTORS SCREENSHOTS
-
 # rebuild all docs
 docs: buildwebsite pdf api-docs
 
 buildwebsite: website
 	-cp doc/*.css website
 	-cp doc/*.png website
-	for d in $(DOCS); do pandoc -s -H doc/header.html -A doc/footer.html -r rst $$d >website/$$d.html; done
+	for d in $(DOCFILES); do pandoc -s -H doc/header.html -A doc/footer.html -r rst $$d >website/$$d.html; done
 	(cd website; rm -f index.html; ln -s HOME.html index.html)
 
 pdf: website
-	for d in $(DOCS); do rst2pdf $$d -o website/$$d.pdf; done
+	for d in $(DOCFILES); do rst2pdf $$d -o website/$$d.pdf; done
 
 website:
 		mkdir -p website
@@ -173,7 +174,7 @@ haddock: api-doc-dir hscolour $(MAIN)
 HSCOLOUR=HsColour -css 
 hscolour: api-doc-dir
 	echo "Generating colourised source" ; \
-	for f in *hs Ledger/*hs; do \
+	for f in $(SOURCEFILES); do \
 		$(HSCOLOUR) -anchor $$f -oapi-doc/`echo "src/"$$f | sed -e's%/%-%g' | sed -e's%\.hs$$%.html%'` ; \
 	done ; \
 	cp api-doc/src-hledger.html api-doc/src-Main.html ; \
@@ -355,7 +356,7 @@ showreleasechanges:
 tag: emacstags
 
 emacstags:
-	@rm -f TAGS; hasktags -e *hs Ledger/*hs hledger.cabal
+	@rm -f TAGS; hasktags -e $(SOURCEFILES) hledger.cabal
 
 clean:
 	rm -f `find . -name "*.o" -o -name "*.hi" -o -name "*~" -o -name "darcs-amend-record*"`

Tests.hs

@@ -154,12 +154,11 @@ import System.Locale (defaultTimeLocale)
 import Text.ParserCombinators.Parsec
 import Test.HUnit
 import Test.HUnit.Tools (assertRaises, runVerboseTests)
+
+import Commands.All
 import Ledger
-import Utils
 import Options
-import BalanceCommand
-import PrintCommand
-import RegisterCommand
+import Utils
 
 
 runtests opts args = runner flattests

hledger.cabal

@@ -56,17 +56,14 @@ Executable hledger
                   regex-pcre, csv, split, utf8-string, http
 
   Other-Modules:  
-                  AddCommand
-                  BalanceCommand
-                  ConvertCommand
-                  HistogramCommand
-                  Options
-                  PrintCommand
-                  RegisterCommand
-                  Setup
-                  Tests
-                  Utils
-                  Version
+                  Commands.Add
+                  Commands.All
+                  Commands.Balance
+                  Commands.Convert
+                  Commands.Histogram
+                  Commands.Print
+                  Commands.Register
+                  Commands.Stats
                   Ledger
                   Ledger.Account
                   Ledger.AccountName
@@ -83,6 +80,11 @@ Executable hledger
                   Ledger.Transaction
                   Ledger.Types
                   Ledger.Utils
+                  Options
+                  Setup
+                  Tests
+                  Utils
+                  Version
 
   -- need to set patchlevel here (darcs changes --from-tag=. --count)
   cpp-options:    -DPATCHES=0
@@ -90,7 +92,7 @@ Executable hledger
   if flag(vty)
     cpp-options: -DVTY
     Build-Depends:vty >= 3.1.8.2 && < 3.2
-    Other-Modules:UICommand
+    Other-Modules:Commands.UI
 
   if flag(happs)
     cpp-options: -DHAPPS
@@ -99,5 +101,5 @@ Executable hledger
                   ,happstack-server >= 0.2 && < 0.3
                   ,happstack-state >= 0.2 && < 0.3
                   ,utf8-string >= 0.3 && < 0.4
-    Other-Modules:WebCommand
+    Other-Modules:Commands.Web
 

hledger.hs

@@ -35,50 +35,25 @@ or ghci:
 See "Ledger.Ledger" for more examples.
 -}
 
-module Main (
-             -- for easy ghci access
+module Main (-- export for easy ghci access:
              module Main,
              module Utils,
              module Options,
-             module BalanceCommand,
-             module ConvertCommand,
-             module PrintCommand,
-             module RegisterCommand,
-             module HistogramCommand,
-             module AddCommand,
-             module StatsCommand,
-#ifdef VTY
-             module UICommand,
-#endif
-#ifdef HAPPS
-             module WebCommand,
-#endif
-)
+             module Commands.All,
+            )
 where
-import Prelude hiding (putStr)
 import Control.Monad.Error
-import qualified Data.Map as Map (lookup)
-import System.IO.UTF8
+import Prelude hiding (putStr)
 import System.IO (stderr)
+import System.IO.UTF8
+import qualified Data.Map as Map (lookup)
 
-import Version (versionmsg)
+import Commands.All
 import Ledger
-import Utils (withLedgerDo)
 import Options
 import Tests
-import BalanceCommand
-import ConvertCommand
-import PrintCommand
-import RegisterCommand
-import HistogramCommand
-import AddCommand
-import StatsCommand
-#ifdef VTY
-import UICommand
-#endif
-#ifdef HAPPS
-import WebCommand
-#endif
+import Utils (withLedgerDo)
+import Version (versionmsg)
 
 
 main :: IO ()