diff --git a/AddCommand.hs b/Commands/Add.hs similarity index 99% rename from AddCommand.hs rename to Commands/Add.hs index 8605e67bf..e9a535857 100644 --- a/AddCommand.hs +++ b/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 diff --git a/Commands/All.hs b/Commands/All.hs new file mode 100644 index 000000000..f388c13c8 --- /dev/null +++ b/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 diff --git a/BalanceCommand.hs b/Commands/Balance.hs similarity index 99% rename from BalanceCommand.hs rename to Commands/Balance.hs index 46a84cf0e..1d42fd077 100644 --- a/BalanceCommand.hs +++ b/Commands/Balance.hs @@ -94,7 +94,7 @@ balance report: -} -module BalanceCommand +module Commands.Balance where import Prelude hiding (putStr) import Ledger.Utils diff --git a/ConvertCommand.hs b/Commands/Convert.hs similarity index 99% rename from ConvertCommand.hs rename to Commands/Convert.hs index 2aef63366..5342f0f82 100644 --- a/ConvertCommand.hs +++ b/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) diff --git a/HistogramCommand.hs b/Commands/Histogram.hs similarity index 96% rename from HistogramCommand.hs rename to Commands/Histogram.hs index 2bc45969e..498991461 100644 --- a/HistogramCommand.hs +++ b/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 diff --git a/PrintCommand.hs b/Commands/Print.hs similarity index 97% rename from PrintCommand.hs rename to Commands/Print.hs index cc2924b61..a3b19a542 100644 --- a/PrintCommand.hs +++ b/Commands/Print.hs @@ -4,7 +4,7 @@ A ledger-compatible @print@ command. -} -module PrintCommand +module Commands.Print where import Prelude hiding (putStr) import Ledger diff --git a/RegisterCommand.hs b/Commands/Register.hs similarity index 99% rename from RegisterCommand.hs rename to Commands/Register.hs index f16fc5d9b..a372403e4 100644 --- a/RegisterCommand.hs +++ b/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 diff --git a/StatsCommand.hs b/Commands/Stats.hs similarity index 99% rename from StatsCommand.hs rename to Commands/Stats.hs index d78595da1..c08aa327d 100644 --- a/StatsCommand.hs +++ b/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 diff --git a/UICommand.hs b/Commands/UI.hs similarity index 99% rename from UICommand.hs rename to Commands/UI.hs index bb249335b..3d18b8eea 100644 --- a/UICommand.hs +++ b/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" diff --git a/WebCommand.hs b/Commands/Web.hs similarity index 73% rename from WebCommand.hs rename to Commands/Web.hs index 973bf9fa7..aa105da26 100644 --- a/WebCommand.hs +++ b/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 " reset" 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 +-- ["
%s" +-- ]) 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 " reset" u + queryValues :: String -> Request -> [String] queryValues q r = map (B.unpack . inputValue . snd) $ filter ((==q).fst) $ rqInputs r diff --git a/Makefile b/Makefile index 28401acf8..970b39fd4 100644 --- a/Makefile +++ b/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*"` diff --git a/Tests.hs b/Tests.hs index 1b125c79a..acbcff4a1 100644 --- a/Tests.hs +++ b/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 diff --git a/hledger.cabal b/hledger.cabal index 5d8e599e4..8422e61b7 100644 --- a/hledger.cabal +++ b/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 diff --git a/hledger.hs b/hledger.hs index 897efae93..27e80a17e 100644 --- a/hledger.hs +++ b/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 ()