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

Safe HaskellNone
LanguageHaskell2010

Buchhaltung.Types

Contents

Synopsis

Documentation

Monad used for most of the funtionality

type CommonM env = RWST (FullOptions env) () () (ErrorT IO) Source #

The Source of an imported transaction

data SFormat a Source #

Constructors

SFormat 

Fields

Instances

Functor SFormat Source # 

Methods

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

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

Eq a => Eq (SFormat a) Source # 

Methods

(==) :: SFormat a -> SFormat a -> Bool #

(/=) :: SFormat a -> SFormat a -> Bool #

Ord a => Ord (SFormat a) Source # 

Methods

compare :: SFormat a -> SFormat a -> Ordering #

(<) :: SFormat a -> SFormat a -> Bool #

(<=) :: SFormat a -> SFormat a -> Bool #

(>) :: SFormat a -> SFormat a -> Bool #

(>=) :: SFormat a -> SFormat a -> Bool #

max :: SFormat a -> SFormat a -> SFormat a #

min :: SFormat a -> SFormat a -> SFormat a #

Read a => Read (SFormat a) Source # 
Show a => Show (SFormat a) Source # 

Methods

showsPrec :: Int -> SFormat a -> ShowS #

show :: SFormat a -> String #

showList :: [SFormat a] -> ShowS #

Generic (SFormat a) Source # 

Associated Types

type Rep (SFormat a) :: * -> * #

Methods

from :: SFormat a -> Rep (SFormat a) x #

to :: Rep (SFormat a) x -> SFormat a #

Hashable a => Hashable (SFormat a) Source # 

Methods

hashWithSalt :: Int -> SFormat a -> Int #

hash :: SFormat a -> Int #

type Rep (SFormat a) Source # 
type Rep (SFormat a) = D1 (MetaData "SFormat" "Buchhaltung.Types" "buchhaltung-0.0.5-FqzJqeYt51uTr8c5y3Xpt" False) (C1 (MetaCons "SFormat" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "fName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 T.Text)) (S1 (MetaSel (Just Symbol "fVersion") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a))))

data Source Source #

represents a key value store and a protocol

Constructors

Source 

Instances

Eq Source Source # 

Methods

(==) :: Source -> Source -> Bool #

(/=) :: Source -> Source -> Bool #

Ord Source Source # 
Read Source Source # 
Show Source Source # 
Generic Source Source # 

Associated Types

type Rep Source :: * -> * #

Methods

from :: Source -> Rep Source x #

to :: Rep Source x -> Source #

A.FromJSON Source Source # 
A.ToJSON Source Source # 
type Rep Source Source # 
type Rep Source = D1 (MetaData "Source" "Buchhaltung.Types" "buchhaltung-0.0.5-FqzJqeYt51uTr8c5y3Xpt" False) (C1 (MetaCons "Source" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "sFormat") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (SFormat Version))) (S1 (MetaSel (Just Symbol "sStore") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (M.Map T.Text T.Text)))))

fromMapToSource :: SFormat Version -> HM.HashMap T.Text T.Text -> Source Source #

Creates a Source from non null values of a HashMap (e.g. from MyRecord)

sourceToMap :: Source -> M.Map T.Text T.Text Source #

produces a map that includes sFormat under the keys "formatName" and "formatVersion"

Import Tag

newtype ImportTag Source #

Constructors

ImportTag 

Instances

Show ImportTag Source # 
IsString ImportTag Source # 
Generic ImportTag Source # 

Associated Types

type Rep ImportTag :: * -> * #

Default ImportTag Source # 

Methods

def :: ImportTag #

type Rep ImportTag Source # 
type Rep ImportTag = D1 (MetaData "ImportTag" "Buchhaltung.Types" "buchhaltung-0.0.5-FqzJqeYt51uTr8c5y3Xpt" True) (C1 (MetaCons "ImportTag" PrefixI True) (S1 (MetaSel (Just Symbol "fromImportTag") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 T.Text)))

Error handling

throwFormat :: MonadError Msg m => Format T.Text t -> (t -> Msg) -> m b Source #

maybeThrow :: MonadError Msg m => Format T.Text t -> (t -> Msg) -> (a1 -> m b) -> Maybe a1 -> m b Source #

lookupErrD Source #

Arguments

:: Show t 
=> [Char]

additional description

-> (t -> t1 -> Maybe a)

lookup function

-> t

lookup arg2

-> t1

lookup arg2

-> a 

lookupErrM :: (MonadError Msg m, Show a) => String -> (a -> t -> Maybe b) -> a -> t -> m b Source #

fromListUnique :: (MonadError Msg m, Show k, Ord k) => [(k, a)] -> m (M.Map k a) Source #

Options

data Options user config env Source #

Constructors

Options 

Fields

Instances

(Show user, Show config, Show env) => Show (Options user config env) Source # 

Methods

showsPrec :: Int -> Options user config env -> ShowS #

show :: Options user config env -> String #

showList :: [Options user config env] -> ShowS #

Generic (Options user config env) Source # 

Associated Types

type Rep (Options user config env) :: * -> * #

Methods

from :: Options user config env -> Rep (Options user config env) x #

to :: Rep (Options user config env) x -> Options user config env #

(NFData user, NFData config, NFData env) => NFData (Options user config env) Source # 

Methods

rnf :: Options user config env -> () #

type Rep (Options user config env) Source # 

Reading options

readConfig :: MonadReader (Options user config env) m => (config -> a) -> m a Source #

readUser :: MonadReader (Options user config env) m => (user -> a) -> m a Source #

user :: MonadReader (Options user config env) m => m user Source #

absolute :: MonadReader (Options user config env) m => FilePath -> m FilePath Source #

get absolute paths in profile dir

Config

data Config Source #

Constructors

Config 

Fields

askTodoFilter :: MonadReader (Options user Config env) m => m (AccountName -> Bool) Source #

User

data User Source #

Constructors

User 

Fields

Instances

Reading User settings

lookupUser :: (MonadError Msg m, MonadReader (Options user Config e) m) => Username -> m User Source #

Looks up a user and throws an error if they do not exist.

defaultUser Source #

Arguments

:: (MonadError Msg m, MonadReader (Options user Config e) m) 
=> Int

default position in user list

-> m User 

A User's ledger files

receivablePayable Source #

Arguments

:: (MonadError Msg m, MonadReader (FullOptions env) m) 
=> Bool

TRUE | FALSE = for (this | the other) user's ledger

-> User

the other user

-> m T.Text 

generates the receiable/payable account for between two users (suffixed by the current, the recording, user)

A user's bank accounts

isIgnored :: User -> AccountName -> Bool Source #

AQBanking

data AQConnection Source #

Constructors

AQConnection 

Instances

Show AQConnection Source # 
Generic AQConnection Source # 

Associated Types

type Rep AQConnection :: * -> * #

A.FromJSON AQConnection Source # 
A.ToJSON AQConnection Source # 
type Rep AQConnection Source # 

data AQType Source #

other modes have to be setup manually. Refer to the AQBanking manual. Use the '-C' to point to the configured configDir.

Constructors

PinTan 
Other 

Instances

Eq AQType Source # 

Methods

(==) :: AQType -> AQType -> Bool #

(/=) :: AQType -> AQType -> Bool #

Show AQType Source # 
Generic AQType Source # 

Associated Types

type Rep AQType :: * -> * #

Methods

from :: AQType -> Rep AQType x #

to :: Rep AQType x -> AQType #

A.FromJSON AQType Source # 
A.ToJSON AQType Source # 
type Rep AQType Source # 
type Rep AQType = D1 (MetaData "AQType" "Buchhaltung.Types" "buchhaltung-0.0.5-FqzJqeYt51uTr8c5y3Xpt" False) ((:+:) (C1 (MetaCons "PinTan" PrefixI False) U1) (C1 (MetaCons "Other" PrefixI False) U1))

data HBCIv Source #

Constructors

HBCI201 
HBCI210 
HBCI220 
HBCI300 

Instances

Show HBCIv Source # 

Methods

showsPrec :: Int -> HBCIv -> ShowS #

show :: HBCIv -> String #

showList :: [HBCIv] -> ShowS #

Generic HBCIv Source # 

Associated Types

type Rep HBCIv :: * -> * #

Methods

from :: HBCIv -> Rep HBCIv x #

to :: Rep HBCIv x -> HBCIv #

A.FromJSON HBCIv Source # 
A.ToJSON HBCIv Source # 
type Rep HBCIv Source # 
type Rep HBCIv = D1 (MetaData "HBCIv" "Buchhaltung.Types" "buchhaltung-0.0.5-FqzJqeYt51uTr8c5y3Xpt" False) ((:+:) ((:+:) (C1 (MetaCons "HBCI201" PrefixI False) U1) (C1 (MetaCons "HBCI210" PrefixI False) U1)) ((:+:) (C1 (MetaCons "HBCI220" PrefixI False) U1) (C1 (MetaCons "HBCI300" PrefixI False) U1)))

toArg :: IsString t => HBCIv -> t Source #

Actions

data Action Source #

Constructors

Add 

Fields

Match 
Import 
Update 

Fields

Commit 

Fields

ListBalances 
Setup 
Ledger 

Fields

HLedger 

Fields

AQBanking 

Fields

Instances

Show Action Source # 
Generic Action Source # 

Associated Types

type Rep Action :: * -> * #

Methods

from :: Action -> Rep Action x #

to :: Rep Action x -> Action #

NFData Action Source # 

Methods

rnf :: Action -> () #

type Rep Action Source # 
type Rep Action = D1 (MetaData "Action" "Buchhaltung.Types" "buchhaltung-0.0.5-FqzJqeYt51uTr8c5y3Xpt" False) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "Add" PrefixI True) (S1 (MetaSel (Just Symbol "aPartners") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Username]))) (C1 (MetaCons "Match" PrefixI False) U1)) ((:+:) (C1 (MetaCons "Import" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "iVersion") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Version))) ((:*:) (S1 (MetaSel (Just Symbol "iPath") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath)) (S1 (MetaSel (Just Symbol "iAction") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ImportAction))))) ((:+:) (C1 (MetaCons "Update" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "aqVersion") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Version))) ((:*:) (S1 (MetaSel (Just Symbol "aqMatch") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) (S1 (MetaSel (Just Symbol "aqRequest") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))))) (C1 (MetaCons "Commit" PrefixI True) (S1 (MetaSel (Just Symbol "cArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String])))))) ((:+:) ((:+:) (C1 (MetaCons "ListBalances" PrefixI False) U1) (C1 (MetaCons "Setup" PrefixI False) U1)) ((:+:) (C1 (MetaCons "Ledger" PrefixI True) (S1 (MetaSel (Just Symbol "lArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String]))) ((:+:) (C1 (MetaCons "HLedger" PrefixI True) (S1 (MetaSel (Just Symbol "hlArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String]))) (C1 (MetaCons "AQBanking" PrefixI True) (S1 (MetaSel (Just Symbol "aqArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String])))))))

Misc

Orphan instances

(Hashable a, Eq a) => Default (HM.HashMap a b) Source # 

Methods

def :: HM.HashMap a b #