diff options
author | Rutger Broekhoff | 2025-07-17 11:33:07 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-07-17 11:33:07 +0200 |
commit | a40d93a36f0dd9f493757d793321f38a58cbb21b (patch) | |
tree | 14abdcf30445ad4e17f1455ee141ccd162a4abd0 /app/Main.hs | |
parent | 533ba31d0a03600f57ad46f6e55229a7f2b60994 (diff) | |
download | rdcapsis-a40d93a36f0dd9f493757d793321f38a58cbb21b.tar.gz rdcapsis-a40d93a36f0dd9f493757d793321f38a58cbb21b.zip |
Adwaita stuff (pre-destruction commit)
Diffstat (limited to 'app/Main.hs')
-rw-r--r-- | app/Main.hs | 239 |
1 files changed, 129 insertions, 110 deletions
diff --git a/app/Main.hs b/app/Main.hs index bc8ad37..97a0463 100644 --- a/app/Main.hs +++ b/app/Main.hs | |||
@@ -1,125 +1,144 @@ | |||
1 | {-# LANGUAGE ImplicitParams #-} | ||
2 | {-# LANGUAGE OverloadedLabels #-} | ||
3 | {-# LANGUAGE OverloadedRecordDot #-} | ||
4 | {-# LANGUAGE OverloadedStrings #-} | ||
5 | |||
1 | module Main where | 6 | module Main where |
2 | 7 | ||
3 | import Brick.AttrMap qualified as A | 8 | import Control.Monad (void) |
4 | import Brick.Main qualified as M | 9 | import Data.GI.Base |
5 | import Brick.Types | 10 | import GI.Adw qualified as Adw |
6 | ( BrickEvent (..), | 11 | import GI.Adw.Objects.ApplicationWindow |
7 | Widget, | 12 | import GI.Gtk qualified as Gtk |
8 | ) | ||
9 | import Brick.Types qualified as T | ||
10 | import Brick.Util (bg, on) | ||
11 | import Brick.Widgets.Center qualified as C | ||
12 | import Brick.Widgets.Core | ||
13 | ( padAll, | ||
14 | str, | ||
15 | ) | ||
16 | import Brick.Widgets.Dialog qualified as D | ||
17 | import Graphics.Vty qualified as V | ||
18 | import Import.Ing.CurrentAccountCsv qualified | 13 | import Import.Ing.CurrentAccountCsv qualified |
19 | import Import.Ing.SavingsAccountCsv qualified | 14 | import Import.Ing.SavingsAccountCsv qualified |
20 | import System.IO (IOMode (ReadMode), withFile) | 15 | import System.IO (IOMode (ReadMode), withFile) |
21 | import Text.Pretty.Simple (pPrint) | 16 | import Text.Pretty.Simple (pPrint) |
22 | 17 | ||
23 | data AccountType = Asset | Equity | Liability | Expense | Income | 18 | -- data AccountType = Asset | Equity | Liability | Expense | Income |
24 | 19 | -- | |
25 | data TxAction = Inc | Dec | 20 | -- data TxAction = Inc | Dec |
26 | 21 | -- | |
27 | txAopp :: TxAction -> TxAction | 22 | -- txAopp :: TxAction -> TxAction |
28 | txaOpp Inc = Dec | 23 | -- txaOpp Inc = Dec |
29 | txaOpp Dec = Inc | 24 | -- txaOpp Dec = Inc |
30 | 25 | -- | |
31 | onDebit :: AccountType -> TxAction | 26 | -- onDebit :: AccountType -> TxAction |
32 | onDebit Asset = Inc | 27 | -- onDebit Asset = Inc |
33 | onDebit Equity = Dec | 28 | -- onDebit Equity = Dec |
34 | onDebit Liability = Dec | 29 | -- onDebit Liability = Dec |
35 | onDebit Expense = Inc | 30 | -- onDebit Expense = Inc |
36 | onDebit Income = Dec | 31 | -- onDebit Income = Dec |
37 | 32 | -- | |
38 | onCredit :: AccountType -> TxAction | 33 | -- onCredit :: AccountType -> TxAction |
39 | onCredit = txaOpp . onDebit | 34 | -- onCredit = txaOpp . onDebit |
40 | 35 | -- | |
41 | data Ledger = [LedgerEntry] | 36 | -- data Ledger = [LedgerEntry] |
42 | 37 | -- | |
43 | data LedgerEntry = TxEntry Tx | BalAssertEntry BalAssert | 38 | -- data LedgerEntry = TxEntry Tx | BalAssertEntry BalAssert |
44 | 39 | -- | |
45 | -- A balance assertion is only valid when all transactions before it have been | 40 | -- -- A balance assertion is only valid when all transactions before it have been |
46 | -- cleared and the balance of the account agrees with the amount in the | 41 | -- -- cleared and the balance of the account agrees with the amount in the |
47 | -- assertion. | 42 | -- -- assertion. |
48 | data BalAssert = BalAssert { | 43 | -- data BalAssert = BalAssert { |
49 | amount :: Decimal, | 44 | -- account :: Account, |
50 | tags :: Tags } | 45 | -- amount :: Decimal, |
51 | 46 | -- tags :: Tags } | |
52 | data Tx = Tx { | 47 | -- |
53 | txClearedAt :: Maybe UTCTime, | 48 | -- data Tx = Tx { |
54 | txCommodity :: Commodity, | 49 | -- txClearedAt :: Maybe UTCTime, |
55 | txDebit :: [(Account, Commodity, Rate, Amount)], | 50 | -- txCommodity :: Commodity, -- the commodity w.r.t. which rates are calculated |
56 | txCredit :: [(Account, Commodity, Rate, Amount)] | 51 | -- txDebit :: [(Account, Rate, Amount)], |
57 | -- Description | 52 | -- txCredit :: [(Account, Rate, Amount)] |
58 | -- Type: | 53 | -- -- Description |
59 | } deriving Show | 54 | -- -- Type: |
60 | 55 | -- } deriving Show | |
61 | data Account = Account { | 56 | -- |
62 | acName :: [T.Text], | 57 | -- data Account = Account { |
63 | acCommodity :: Commodity, | 58 | -- acName :: [T.Text], |
64 | acBalance :: Amount } | 59 | -- acBalance :: Amount } |
65 | 60 | ||
66 | data Choice = Red | Blue | Green | 61 | activate :: Adw.Application -> IO () |
67 | deriving (Show) | 62 | activate app = do |
68 | 63 | button <- | |
69 | data Name | 64 | new |
70 | = RedButton | 65 | Gtk.Button |
71 | | BlueButton | 66 | [ #label := "Click me", |
72 | | GreenButton | 67 | On |
73 | deriving (Show, Eq, Ord) | 68 | #clicked |
74 | 69 | ( ?self | |
75 | drawUI :: D.Dialog Choice Name -> [Widget Name] | 70 | `set` [ #sensitive := False, |
76 | drawUI d = [ui] | 71 | #label := "Thanks for clicking me" |
77 | where | 72 | ] |
78 | ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." | 73 | ) |
79 | 74 | ] | |
80 | appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) () | 75 | button2 <- |
81 | appEvent (VtyEvent ev) = | 76 | new |
82 | case ev of | 77 | Gtk.Button |
83 | V.EvKey V.KEsc [] -> M.halt | 78 | [ #label := "Click me", |
84 | V.EvKey V.KEnter [] -> M.halt | 79 | On |
85 | _ -> D.handleDialogEvent ev | 80 | #clicked |
86 | appEvent _ = return () | 81 | ( ?self |
82 | `set` [ #sensitive := False, | ||
83 | #label := "Thanks for clicking me" | ||
84 | ] | ||
85 | ) | ||
86 | ] | ||
87 | 87 | ||
88 | initialState :: D.Dialog Choice Name | 88 | title <- new Adw.WindowTitle [ #title := "rdcapsis" ] |
89 | initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50 | 89 | topBar <- new Adw.HeaderBar |
90 | where | 90 | [ #titleWidget := title ] |
91 | choices = | 91 | |
92 | [ ("Red", RedButton, Red), | 92 | sidebarToolbarView <- |
93 | ("Blue", BlueButton, Blue), | 93 | new Adw.ToolbarView |
94 | ("Green", GreenButton, Green) | 94 | [ #content := button ] |
95 | |||
96 | mainToolbarView <- | ||
97 | new Adw.ToolbarView | ||
98 | [] | ||
99 | mainToolbarView.addTopBar topBar | ||
100 | |||
101 | sidebarNavPage <- new Adw.NavigationPage | ||
102 | [ #title := "Accounts", | ||
103 | #tag := "sidebar", | ||
104 | #child := sidebarToolbarView ] | ||
105 | |||
106 | mainNavPage <- new Adw.NavigationPage | ||
107 | [ #title := "Content", | ||
108 | #tag := "content", | ||
109 | #child := mainToolbarView ] | ||
110 | |||
111 | splitView <- new Adw.NavigationSplitView | ||
112 | [ #sidebar := sidebarNavPage, | ||
113 | #content := mainNavPage ] | ||
114 | |||
115 | window <- | ||
116 | new | ||
117 | Adw.ApplicationWindow | ||
118 | [ #application := app, | ||
119 | #content := splitView, | ||
120 | #widthRequest := 280, | ||
121 | #heightRequest := 200, | ||
122 | #defaultWidth := 800, | ||
123 | #defaultHeight := 800 | ||
95 | ] | 124 | ] |
96 | 125 | ||
97 | theMap :: A.AttrMap | 126 | cond <- Adw.breakpointConditionParse "max-width: 400sp" |
98 | theMap = | 127 | breakpoint <- new Adw.Breakpoint [ #condition := cond, |
99 | A.attrMap | 128 | On #apply (splitView.setCollapsed True), |
100 | V.defAttr | 129 | On #unapply (splitView.setCollapsed False) ] |
101 | [ (D.dialogAttr, V.white `on` V.blue), | 130 | window.addBreakpoint breakpoint |
102 | (D.buttonAttr, V.black `on` V.white), | ||
103 | (D.buttonSelectedAttr, bg V.yellow) | ||
104 | ] | ||
105 | 131 | ||
106 | theApp :: M.App (D.Dialog Choice Name) e Name | 132 | window.present |
107 | theApp = | ||
108 | M.App | ||
109 | { M.appDraw = drawUI, | ||
110 | M.appChooseCursor = M.showFirstCursor, | ||
111 | M.appHandleEvent = appEvent, | ||
112 | M.appStartEvent = return (), | ||
113 | M.appAttrMap = const theMap | ||
114 | } | ||
115 | 133 | ||
116 | main :: IO () | 134 | main :: IO () |
117 | main = do | 135 | main = do |
118 | let filename = "/home/rutgerbrf/Code/P/rdcapsis/test3.csv" | 136 | app <- |
119 | putStrLn $ "Reading " ++ filename | 137 | new |
120 | withFile filename ReadMode $ \h -> do | 138 | Adw.Application |
121 | entries <- Import.Ing.CurrentAccountCsv.readFile h | 139 | [ #applicationId := "eu.fautchen.rdcapsis", |
122 | pPrint entries | 140 | On #activate (activate ?self) |
141 | ] | ||
142 | void $ app.run Nothing | ||
123 | 143 | ||
124 | -- d <- M.defaultMain theApp initialState | 144 | -- window <- applicationWindowNew |
125 | -- putStrLn $ "You chose: " <> show (D.dialogSelection d) | ||