simplify: drop the ansi ui, and enable the vty ui by default

If what I'm hearing is correct, cabal on windows will turn off the vty
flag automatically. The alternative ansi ui is not worth the hassle.

ANSICommand.hs

@@ -1,357 +0,0 @@
-{-| 
-
-A simple text UI for hledger, based on the ansi-terminal library.
-Duplicates most of UICommand.hs for now.
-
--}
-
-module ANSICommand
-where
-import qualified Data.Map as Map
-import Data.Map ((!))
-import qualified Data.ByteString.Char8 as B
-import System.Console.ANSI
-import System.IO
-import Ledger
-import Options
-import BalanceCommand
-import RegisterCommand
-import PrintCommand
-
-
-helpmsg = "Welcome to hledger ansi ui. (n)ext, (p)revious, (enter), (b)ack, or (q)uit"
-
--- | The application state when running the ui command.
-data AppState = AppState {
-     aw :: Int                   -- ^ window width
-    ,ah :: Int                   -- ^ window height
-    ,amsg :: String              -- ^ status message
-    ,aopts :: [Opt]              -- ^ command-line opts
-    ,aargs :: [String]           -- ^ command-line args
-    ,aledger :: Ledger           -- ^ parsed ledger
-    ,abuf :: [String]            -- ^ lines of the current buffered view
-    ,alocs :: [Loc]              -- ^ user's navigation trail within the UI
-                                -- ^ never null, head is current location
-    } deriving (Show)
-
--- | A location within the user interface.
-data Loc = Loc {
-     scr :: Screen               -- ^ one of the available screens
-    ,sy :: Int                   -- ^ viewport y scroll position
-    ,cy :: Int                   -- ^ cursor y position
-    } deriving (Show)
-
--- | The screens available within the user interface.
-data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts
-            | RegisterScreen    -- ^ like hledger register, shows transactions
-            | PrintScreen       -- ^ like hledger print, shows entries
-            | LedgerScreen      -- ^ shows the raw ledger
-              deriving (Eq,Show)
-
--- | Run the interactive text ui.
-ansi :: [Opt] -> [String] -> Ledger -> IO ()
-ansi opts args l = do
-  let (w,h) = (80,25)
-  let opts' = SubTotal:opts
-  let a = enter BalanceScreen $ 
-          AppState {
-                  aw=w
-                 ,ah=h
-                 ,amsg=helpmsg
-                 ,aopts=opts'
-                 ,aargs=args
-                 ,aledger=l
-                 ,abuf=[]
-                 ,alocs=[]
-                 }
-  hSetBuffering stdin NoBuffering
-  hSetEcho stdin False
-  go a 
-
--- | Update the screen, wait for the next event, repeat.
-go :: AppState -> IO ()
-go a@AppState{aw=aw,ah=ah,abuf=buf,amsg=amsg,aopts=opts,aargs=args,aledger=l} = do
-  when (not $ DebugNoUI `elem` opts) $ updateScreen a
-  c <- getChar
-  case c of 
---     EvResize x y                -> go $ resize x y a
---     EvKey (KASCII 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg}
---     EvKey (KASCII 'b') []       -> go $ resetTrailAndEnter BalanceScreen a
---     EvKey (KASCII 'r') []       -> go $ resetTrailAndEnter RegisterScreen a
---     EvKey (KASCII 'p') []       -> go $ resetTrailAndEnter PrintScreen a
---     EvKey (KASCII 'l') []       -> go $ resetTrailAndEnter LedgerScreen a
---     EvKey KRight []             -> go $ drilldown a
-    '\n'            -> go $ drilldown a
-    'b'             -> go $ backout a
-    'p'             -> go $ moveUpAndPushEdge a
-    'n'             -> go $ moveDownAndPushEdge a
-    '<'             -> go $ moveToTop a
-    '>'             -> go $ moveToBottom a
---     EvKey KHome  []             -> go $ moveToTop a
---     EvKey KUp    [MCtrl]        -> go $ moveToTop a
---     EvKey KUp    [MShift]       -> go $ moveToTop a
---     EvKey KEnd   []             -> go $ moveToBottom a
---     EvKey KDown  [MCtrl]        -> go $ moveToBottom a
---     EvKey KDown  [MShift]       -> go $ moveToBottom a
---     EvKey KPageUp []            -> go $ prevpage a
---     EvKey KBS []                -> go $ prevpage a
---     EvKey (KASCII ' ') [MShift] -> go $ prevpage a
---     EvKey KPageDown []          -> go $ nextpage a
---     EvKey (KASCII ' ') []       -> go $ nextpage a
---     EvKey (KASCII 'q') []       -> shutdown av >> return ()
---    EvKey KEsc   []           -> shutdown av >> return ()
-    'q'                         -> resetScreen 0 0
-    _                           -> print c >> go a
-    where
-      bh = length buf
-      y = posY a
-
--- app state modifiers
-
--- | The number of lines currently available for the main data display area.
-pageHeight :: AppState -> Int
-pageHeight a = ah a - 1
-
-setLocCursorY, setLocScrollY :: Int -> Loc -> Loc
-setLocCursorY y l = l{cy=y}
-setLocScrollY y l = l{sy=y}
-
-cursorY, scrollY, posY :: AppState -> Int
-cursorY = cy . loc
-scrollY = sy . loc
-posY a = scrollY a + cursorY a
-
-setCursorY, setScrollY, setPosY :: Int -> AppState -> AppState
-setCursorY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocCursorY y l
-setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocScrollY y l
-setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}
-    where 
-      l' = setLocScrollY sy $ setLocCursorY cy l
-      ph = pageHeight a
-      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
-updatePosY f a = setPosY (f $ posY a) a
-
-resize :: Int -> Int -> AppState -> AppState
-resize x y a = setCursorY cy' a{aw=x,ah=y}
-    where
-      cy = cursorY a
-      cy' = min cy (y-2)
-
-moveToTop :: AppState -> AppState
-moveToTop a = setPosY 0 a
-
-moveToBottom :: AppState -> AppState
-moveToBottom a = setPosY (length $ abuf a) a
-
-moveUpAndPushEdge :: AppState -> AppState
-moveUpAndPushEdge a@AppState{alocs=(Loc{sy=sy,cy=cy}:_)}
-    | cy > 0 = updateCursorY (subtract 1) a
-    | sy > 0 = updateScrollY (subtract 1) a
-    | otherwise = a
-
-moveDownAndPushEdge :: AppState -> AppState
-moveDownAndPushEdge a@AppState{alocs=(Loc{sy=sy,cy=cy}:_)}
-    | sy+cy >= bh = a
-    | cy < ph-1 = updateCursorY (+1) a
-    | otherwise = updateScrollY (+1) a
-    where 
-      ph = pageHeight a
-      bh = length $ abuf a
-
--- | Scroll down by page height or until we can just see the last line,
--- without moving the cursor, or if we are already scrolled as far as
--- possible then move the cursor to the last line.
-nextpage :: AppState -> AppState
-nextpage (a@AppState{abuf=b})
-    | sy < bh-jump = setScrollY sy' a
-    | otherwise    = setCursorY (bh-sy) a
-    where
-      sy = scrollY a
-      jump = pageHeight a - 1
-      bh = length b
-      sy' = min (sy+jump) (bh-jump)
-
--- | Scroll up by page height or until we can just see the first line,
--- 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})
-    | sy > 0    = setScrollY sy' a
-    | otherwise = setCursorY 0 a
-    where
-      sy = scrollY a
-      jump = pageHeight a - 1
-      sy' = max (sy-jump) 0
-
--- | Push a new UI location on to the stack.
-pushLoc :: Loc -> AppState -> AppState
-pushLoc l a = a{alocs=(l:alocs a)}
-
-popLoc :: AppState -> AppState
-popLoc a@AppState{alocs=locs}
-    | length locs > 1 = a{alocs=drop 1 locs}
-    | otherwise = a
-
-clearLocs :: AppState -> AppState
-clearLocs a = a{alocs=[]}
-
-exit :: AppState -> AppState 
-exit = popLoc
-
-loc :: AppState -> Loc
-loc = head . alocs
-
-screen :: AppState -> Screen
-screen a = scr where (Loc scr _ _) = loc a
-
--- | Enter a new screen, saving the old ui location on the stack.
-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
-
-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}
-    | scr == BalanceScreen  = a{abuf=lines $ showBalanceReport opts [] l, aargs=[]}
-    | scr == RegisterScreen = a{abuf=lines $ showRegisterReport opts args l}
-    | scr == PrintScreen    = a{abuf=lines $ showEntries opts args l}
-    | scr == LedgerScreen   = a{abuf=lines $ rawledgertext l}
-    where scr = screen a
-
-backout :: AppState -> AppState
-backout a
-    | screen a == BalanceScreen = a
-    | otherwise = updateData $ popLoc a
-
-drilldown :: AppState -> AppState
-drilldown a
-    | screen a == BalanceScreen  = enter RegisterScreen a{aargs=[currentAccountName a]}
-    | screen a == RegisterScreen = scrollToEntry e $ enter PrintScreen a
-    | screen a == PrintScreen   = enter LedgerScreen a
-    | screen a == LedgerScreen   = a
-    where e = currentEntry a
-
--- | Get the account name currently highlighted by the cursor on the
--- balance screen. Results undefined while on other screens.
-currentAccountName :: AppState -> AccountName
-currentAccountName a = accountNameAt (abuf a) (posY a)
-
--- | Get the full name of the account being displayed at a specific line
--- within the balance command's output.
-accountNameAt :: [String] -> Int -> AccountName
-accountNameAt buf lineno = accountNameFromComponents anamecomponents
-    where
-      namestohere = map (drop 22) $ take (lineno+1) buf
-      (indented, nonindented) = span (" " `isPrefixOf`) $ reverse namestohere
-      thisbranch = indented ++ take 1 nonindented
-      anamecomponents = reverse $ map strip $ dropsiblings thisbranch
-
-      dropsiblings :: [AccountName] -> [AccountName]
-      dropsiblings [] = []
-      dropsiblings (x:xs) = [x] ++ dropsiblings xs'
-          where
-            xs' = dropWhile moreindented xs
-            moreindented = (>= myindent) . indentof
-            myindent = indentof x
-            indentof = length . takeWhile (==' ')
-
--- | If on the print screen, move the cursor to highlight the specified entry
--- (or a reasonable guess). Doesn't work.
-scrollToEntry :: Entry -> AppState -> AppState
-scrollToEntry e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
-    where
-      entryfirstline = head $ lines $ showEntry $ e
-      halfph = pageHeight a `div` 2
-      y = fromMaybe 0 $ findIndex (== entryfirstline) buf
-      sy = max 0 $ y - halfph
-      cy = y - sy
-
--- | Get the entry containing the transaction currently highlighted by the
--- cursor on the register screen (or best guess). Results undefined while
--- on other screens. Doesn't work.
-currentEntry :: AppState -> Entry
-currentEntry a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
-    where
-      t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
-      ismatch t = date t == (parsedate $ take 10 datedesc)
-                  && (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt)
-      datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above
-      acctamt = drop 32 $ safehead "" rest
-      safehead d ls = if null ls then d else head ls
-      (above,rest) = splitAt y buf
-      y = posY a
-
--- | Get the entry which contains the given transaction.
--- Will raise an error if there are problems.
-entryContainingTransaction :: AppState -> Transaction -> Entry
-entryContainingTransaction AppState{aledger=l} t = (entries $ rawledger l) !! entryno t
-
--- renderers
-
-renderScreen :: AppState -> String
-renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) = maintext ++ renderStatus w msg
-    where 
-      (cx, cy) = (0, cursorY a)
-      sy = scrollY a
---       maintext = (vertcat $ map (render defaultattr) above)
---                  (render currentlineattr thisline)
---                  (vertcat $ map (render defaultattr) below)
---       (thisline,below) | null rest = (blankline,[])
---                        | otherwise = (head rest, tail rest)
---       (above,rest) = splitAt cy linestorender
-      maintext = unlines $ map padclipline $ take (h-1) $ drop sy $ buf ++ replicate h blankline
-      padclipline l = take w $ l ++ blankline
-      blankline = replicate w ' '
---       mainimg = (renderString attr $ unlines $ above)
---           <->
---           (renderString reverseattr $ thisline)
---           <->
---           (renderString attr $ unlines $ below)
---       (above,(thisline:below)) 
---           | null ls   = ([],[""])
---           | otherwise = splitAt y ls
---       ls = lines $ fitto w (h-1) $ unlines $ drop as $ buf
-
--- padClipString :: Int -> Int -> String -> [String]
--- padClipString h w s = rows
---     where
---       rows = map padclipline $ take h $ lines s ++ replicate h blankline
---       padclipline l = take w $ l ++ blankline
---       blankline = replicate w ' '
-
--- renderString :: Attr -> String -> Image
--- renderString attr s = vertcat $ map (renderBS attr . B.pack) rows
---     where
---       rows = lines $ fitto w h s
---       w = maximum $ map length $ ls
---       h = length ls
---       ls = lines s
-
-renderStatus :: Int -> String -> String
-renderStatus w s = {- statusattr -} take w (s ++ repeat ' ')
-
-
--- ansi output
-
-updateScreen :: AppState -> IO ()
-updateScreen a = putAnsiStr (renderScreen a) 0 (cursorY a)
-
-putAnsiStr :: String -> Int -> Int -> IO ()
-putAnsiStr s cx cy = do
-  resetScreen 0 0
-  putStr s
-  setCursorPosition cy cx
-  hFlush stdout
-
-resetScreen :: Int -> Int -> IO ()
-resetScreen cx cy = clearScreen >> setSGR [Reset] >> setCursorPosition cy cx
-

Makefile

@@ -9,7 +9,7 @@ PATCHES:=$(shell expr `darcs changes --count --from-tag=\\\\\.` - 1)
 BUILD=ghc --make hledger.hs -o hledger -O
 FLAGS=-DPATCHES=$(PATCHES)
 # optional extras described in README, turn em on if you've got the libs
-OPTFLAGS=-DVTY -DHAPPS # -DANSI
+OPTFLAGS= #-DVTY -DHAPPS
 BUILDFLAGS=$(FLAGS) $(OPTFLAGS)
 build: setversion
 	@$(BUILD) $(BUILDFLAGS)

NEWS

@@ -1,5 +1,3 @@
-NEWS
-----
 
 2009/04/03 hledger 0.4 released
 -------------------------------
@@ -7,9 +5,8 @@ NEWS
 Changes:
 ........
 
-  * avoid bulky/non-portable dependencies by default, curses ui now requires a build flag (-f vty)
+  * new "web" command serves reports in a web browser (install with -f happs to build this)
-  * on MS windows, provide a simple ansi-based ui in place of vty (-f ansi)
+  * make the vty-based curses ui a cabal build option, which will be ignored on MS windows
-  * new "web" command starts a webserver and shows reports in a browser (-f happs)
   * drop the --options-anywhere flag, that is now the default
   * patterns now use not: and desc: prefixes instead of ^ and ^^
   * patterns are now case-insensitive, like ledger
@@ -161,4 +158,3 @@ Stats:
 Contributors:
 
   * Simon Michael
-

Options.hs

@@ -31,8 +31,6 @@ usagehdr = printf (
   "  register - show register transactions\n" ++
 #ifdef VTY
   "  ui       - run a simple curses-based text ui\n" ++
-#elif ANSI
-  "  ui       - run a simple ansi-based text ui\n" ++
 #endif
 #ifdef HAPPS
   "  web      - run a simple web ui\n" ++

README

@@ -27,20 +27,9 @@ hledger.cabal from hackage.org, but installing cabal is much quicker.)
 Here's how to download and install the latest hledger release::
 
  cabal update
- cabal install hledger
+ cabal install hledger (add -f happs to include the web ui)
 
-Or, to build with all optional features enabled (downloads additional
+Or, to get the latest development code::
-dependencies)::
-
- cabal install --flags="happs vty" hledger
-
-The available flags are::
-
-  happs - enable the webserver ui
-  vty   - enable the curses text ui
-  ansi  - enable the ansi text ui (use instead of vty on MS windows)
-
-For developers, here's how to get the latest code::
 
  darcs get http://joyful.com/repos/hledger
 
@@ -65,7 +54,7 @@ Here are some commands to try::
  hledger register
  hledger reg income
  hledger reg desc:shop
- hledger ui  # if you installed with -f vty or ansi
+ hledger ui
  hledger web # if you installed with -f happs
 
 
@@ -139,8 +128,8 @@ We handle (almost) the full period expression syntax, and very limited
 display expressions consisting of a simple date predicate. Also the
 following new commands are supported::
 
-   ui                     a simple curses-based text ui (on windows, ansi-based)
+   ui                     a simple interactive text ui (only on unix platforms)
-   web                    a simple web-based ui
+   web                    a simple web ui
    test                   run self-tests
 
 ledger features not supported

Version.hs

@@ -39,8 +39,6 @@ versionmsg    = progname ++ " " ++ versionstr ++ configmsg ++ "\n"
 configflags   = tail [""
 #ifdef VTY
   ,"vty"
-#elif ANSI
-  ,"ansi"
 #endif
 #ifdef HAPPS
   ,"happs"

hledger.cabal

@@ -18,16 +18,12 @@ Extra-Source-Files: README sample.ledger
 Extra-Tmp-Files: 
 Cabal-Version:  >= 1.2
 
-Flag happs
-  description: enable the webserver ui
-  default:     False
-
 Flag vty
-  description: enable the curses test ui
+  description: enable the curses ui
-  default:     False
+  default:     True
 
-Flag ansi
+Flag happs
-  description: enable the ansi text ui (use instead of vty on MS windows)
+  description: enable the web ui
   default:     False
 
 Library
@@ -86,21 +82,16 @@ Executable hledger
   cpp-options:    -DPATCHES=0
 
   if flag(vty)
+    cpp-options: -DVTY
     Build-Depends:vty >= 3.1.8.2 && < 3.2
     Other-Modules:UICommand
-    cpp-options: -DVTY
-
-  if flag(ansi)
-    Build-Depends:ansi-terminal >= 0.5 && < 0.6
-    Other-Modules:ANSICommand
-    cpp-options: -DANSI
 
   if flag(happs)
+    cpp-options: -DHAPPS
     Build-Depends:happstack >= 0.2 && < 0.3
                   ,happstack-data >= 0.2 && < 0.3
                   ,happstack-server >= 0.2 && < 0.3
                   ,happstack-state >= 0.2 && < 0.3
                   ,utf8-string >= 0.3 && < 0.4
     Other-Modules:WebCommand
-    cpp-options: -DHAPPS
 

hledger.hs

@@ -59,8 +59,6 @@ import PrintCommand
 import RegisterCommand
 #ifdef VTY
 import UICommand
-#elif ANSI
-import ANSICommand
 #endif
 #ifdef HAPPS
 import WebCommand
@@ -80,8 +78,6 @@ main = do
        | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args register
 #ifdef VTY
        | cmd `isPrefixOf` "ui"       = parseLedgerAndDo opts args ui
-#elif ANSI
-       | cmd `isPrefixOf` "ui"       = parseLedgerAndDo opts args ansi
 #endif
 #ifdef HAPPS
        | cmd `isPrefixOf` "web"      = parseLedgerAndDo opts args web