summaryrefslogtreecommitdiffstats
path: root/app/Main.hs
blob: bc8ad3731c53c94ee3b7951abb8fe12f2ac2c088 (about) (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
module Main where

import Brick.AttrMap qualified as A
import Brick.Main qualified as M
import Brick.Types
  ( BrickEvent (..),
    Widget,
  )
import Brick.Types qualified as T
import Brick.Util (bg, on)
import Brick.Widgets.Center qualified as C
import Brick.Widgets.Core
  ( padAll,
    str,
  )
import Brick.Widgets.Dialog qualified as D
import Graphics.Vty qualified as V
import Import.Ing.CurrentAccountCsv qualified
import Import.Ing.SavingsAccountCsv qualified
import System.IO (IOMode (ReadMode), withFile)
import Text.Pretty.Simple (pPrint)

data AccountType = Asset | Equity | Liability | Expense | Income

data TxAction = Inc | Dec

txAopp :: TxAction -> TxAction
txaOpp Inc = Dec
txaOpp Dec = Inc

onDebit :: AccountType -> TxAction
onDebit Asset = Inc
onDebit Equity = Dec
onDebit Liability = Dec
onDebit Expense = Inc
onDebit Income = Dec

onCredit :: AccountType -> TxAction
onCredit = txaOpp . onDebit

data Ledger = [LedgerEntry]

data LedgerEntry = TxEntry Tx | BalAssertEntry BalAssert

-- A balance assertion is only valid when all transactions before it have been
-- cleared and the balance of the account agrees with the amount in the
-- assertion.
data BalAssert = BalAssert {
  amount :: Decimal,
  tags :: Tags }

data Tx = Tx {
  txClearedAt :: Maybe UTCTime,
  txCommodity :: Commodity,
  txDebit :: [(Account, Commodity, Rate, Amount)],
  txCredit :: [(Account, Commodity, Rate, Amount)]
  -- Description
  -- Type: 
             } deriving Show

data Account = Account {
  acName :: [T.Text],
  acCommodity :: Commodity,
  acBalance :: Amount }

data Choice = Red | Blue | Green
  deriving (Show)

data Name
  = RedButton
  | BlueButton
  | GreenButton
  deriving (Show, Eq, Ord)

drawUI :: D.Dialog Choice Name -> [Widget Name]
drawUI d = [ui]
  where
    ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body."

appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) ()
appEvent (VtyEvent ev) =
  case ev of
    V.EvKey V.KEsc [] -> M.halt
    V.EvKey V.KEnter [] -> M.halt
    _ -> D.handleDialogEvent ev
appEvent _ = return ()

initialState :: D.Dialog Choice Name
initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50
  where
    choices =
      [ ("Red", RedButton, Red),
        ("Blue", BlueButton, Blue),
        ("Green", GreenButton, Green)
      ]

theMap :: A.AttrMap
theMap =
  A.attrMap
    V.defAttr
    [ (D.dialogAttr, V.white `on` V.blue),
      (D.buttonAttr, V.black `on` V.white),
      (D.buttonSelectedAttr, bg V.yellow)
    ]

theApp :: M.App (D.Dialog Choice Name) e Name
theApp =
  M.App
    { M.appDraw = drawUI,
      M.appChooseCursor = M.showFirstCursor,
      M.appHandleEvent = appEvent,
      M.appStartEvent = return (),
      M.appAttrMap = const theMap
    }

main :: IO ()
main = do
  let filename = "/home/rutgerbrf/Code/P/rdcapsis/test3.csv"
  putStrLn $ "Reading " ++ filename
  withFile filename ReadMode $ \h -> do
    entries <- Import.Ing.CurrentAccountCsv.readFile h
    pPrint entries

--  d <- M.defaultMain theApp initialState
--  putStrLn $ "You chose: " <> show (D.dialogSelection d)