buchhaltung-0.0.7: Automates most of your plain text accounting data entry in ledger format.

Copyright(c) 2008 Brent Yorgey
LicenseBSD-style (see LICENSE)
Maintainer<byorgey@gmail.com>
Stabilityunstable
Portabilityunportable
Safe HaskellNone
LanguageHaskell2010

Buchhaltung.ZipEdit2

Contents

Description

A library for creating simple interactive list editors, using a zipper to allow the user to navigate forward and back within the list and edit the list elements.

Synopsis

Example usage

Here is a simple example of using the ZipEdit library:

module Main where

import System.Console.ZipEdit

myEd = EC { display = const ""
          , ecPrompt  = \n -> maybe "" show n ++ "? "
          , actions = [ ('+', Modify (+1) ?? "Increment the current number.")
                      , ('i', InsFwd "Value to insert: " read ?? "Insert a number.")
                      ]
                      ++ stdActions
          }

main = do
  mxs <- edit myEd [1..10]
  case mxs of
    Nothing -> putStrLn "Canceled."
    Just xs -> putStrLn ("Final edited version: " ++ show xs)

A session with this program might look something like this:

$ test

1? k

1? j

2? j

3? +

4? +

5? j

4? i
Value to insert: 98

98? d
Final edited version: [1,2,5,4,98,5,6,7,8,9,10]

For more sophisticated examples, see planethaskell.hs and gmane.hs in http://code.haskell.org/~byorgey/code/hwn/utils.

Interface

data Action m a u Source #

Actions that can be taken by an editor in response to user input.

Constructors

Comp (Action m a u) (Action m a u) 
Fwd

move forward one item.

Back

move back one item.

Delete

delete the current item.

Modify (a -> a)

modify the current item by applying the given function.

ModifyState (LState a u -> LState a u)

modify complete state

ModifyStateM (LState a u -> m (LState a u))

modify complete state with IO.

ModifyAllM (Zipper a -> m (Zipper a))

modify everything with IO.

ModifyAll (Zipper a -> Zipper a)

modify everything.

ModifyM (a -> m a)

modify the current item by applying the given function, which gives its result in the IO monad.

ModifyFwd ([a] -> [a])

modify items following the current item by applying the given function.

ModifyBack ([a] -> [a])

modify items before the current item by applying the given function.

ModifyWInp String (String -> a -> a)

Using the given string as a prompt, obtain a line of user input, and apply the given function to the user input to obtain a function for modifying the current item.

ModifyWEditor (a -> String) (String -> a -> a)

Run the first function on the current item to produce a string, and open an editor (using the $EDITOR environment variable) on that string. After the user is done editing, pass the resulting string to the second function to obtain a function for modifying the current element.

InsFwd String (String -> a)

Using the given string as a prompt, obtain a line of user input, and apply the given function to the user input to obtain a new item, which should be inserted forward of the current item. The inserted item becomes the new current item.

InsBack String (String -> a)

Similar to InsFwd, except that the new item is inserted before the old current item.

Output (a -> String)

output a string which is a function of the current item.

Cancel

cancel the editing session.

Done (LState a u -> m (Maybe (LState a u)))

complete the editing session, but if te function evaluates to Just and the suer answers y. In this case return the functions result.

Seq [Action m a u]

perform a sequence of actions.

Help String (Action m a u)

an action annotated with a help string.

Instances

Monoid (Action m a u) Source # 

Methods

mempty :: Action m a u #

mappend :: Action m a u -> Action m a u -> Action m a u #

mconcat :: [Action m a u] -> Action m a u #

stdActions :: Monad m => [(Char, Action m a u)] Source #

Some standard actions which can be used in constructing editor configurations. The actions are: j - Fwd, k - Back, x - Delete, q - Cancel, d - Done.

(??) :: Action m a u -> String -> Action m a u Source #

Annotate a command with a help string.

data EditorConf m a u Source #

A configuration record determining the behavior of the editor.

Constructors

EC 

Fields

edit Source #

Arguments

:: MonadIO m 
=> EditorConf m a u

editor configuration

-> u

initial userState

-> NonEmpty a

the list to edit

-> (Zipper a -> Zipper a)

startupModifier

-> m (Maybe (u, [a])) 

Run the given editor on the given list, returning Nothing if the user canceled the editing process, or Just l if the editing process completed successfully, where l is the final state of the list being edited.

data LCont a Source #

A continuation which can compute more of the list, along with (maybe) another continuation.

Constructors

LC (IO ([a], Maybe (LCont a))) 

editWCont Source #

Arguments

:: MonadIO m 
=> EditorConf m a u 
-> NonEmpty a

the list to edit

-> u

initial userState

-> IO ([a], Maybe (LCont a)) 
-> (Zipper a -> Zipper a)

startupModifier

-> m (Maybe (u, [a])) 

Like edit, but with an additional parameter for a continuation | which can be run to compute additional list elements and | (optionally) another continuation.

data Zipper a Source #

Nonemtpy zipper

Constructors

LZ 

Fields

Instances

Functor Zipper Source # 

Methods

fmap :: (a -> b) -> Zipper a -> Zipper b #

(<$) :: a -> Zipper b -> Zipper a #

integrate :: Zipper a -> [a] Source #

differentiate :: NonEmpty a -> Zipper a Source #

Turn a list into a context with the focus on the first element.

fwd :: Zipper a -> Zipper a Source #

Move the focus to the next element. Do nothing if the focus is | already on the last element.

back :: Zipper a -> Zipper a Source #

Move the focus to the previous element. Do nothing if the focus | is already on the first element.

data LState a b Source #

The state of the editor consists of a current context, as well as an optional continuation which can compute more list elements.

Constructors

LS 

Fields