summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRutger Broekhoff2025-07-17 11:33:07 +0200
committerRutger Broekhoff2025-07-17 11:33:07 +0200
commita40d93a36f0dd9f493757d793321f38a58cbb21b (patch)
tree14abdcf30445ad4e17f1455ee141ccd162a4abd0
parent533ba31d0a03600f57ad46f6e55229a7f2b60994 (diff)
downloadrdcapsis-a40d93a36f0dd9f493757d793321f38a58cbb21b.tar.gz
rdcapsis-a40d93a36f0dd9f493757d793321f38a58cbb21b.zip
Adwaita stuff (pre-destruction commit)
-rw-r--r--app/Main.hs239
-rw-r--r--rdcapsis.cabal7
2 files changed, 133 insertions, 113 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
1module Main where 6module Main where
2 7
3import Brick.AttrMap qualified as A 8import Control.Monad (void)
4import Brick.Main qualified as M 9import Data.GI.Base
5import Brick.Types 10import GI.Adw qualified as Adw
6 ( BrickEvent (..), 11import GI.Adw.Objects.ApplicationWindow
7 Widget, 12import GI.Gtk qualified as Gtk
8 )
9import Brick.Types qualified as T
10import Brick.Util (bg, on)
11import Brick.Widgets.Center qualified as C
12import Brick.Widgets.Core
13 ( padAll,
14 str,
15 )
16import Brick.Widgets.Dialog qualified as D
17import Graphics.Vty qualified as V
18import Import.Ing.CurrentAccountCsv qualified 13import Import.Ing.CurrentAccountCsv qualified
19import Import.Ing.SavingsAccountCsv qualified 14import Import.Ing.SavingsAccountCsv qualified
20import System.IO (IOMode (ReadMode), withFile) 15import System.IO (IOMode (ReadMode), withFile)
21import Text.Pretty.Simple (pPrint) 16import Text.Pretty.Simple (pPrint)
22 17
23data AccountType = Asset | Equity | Liability | Expense | Income 18-- data AccountType = Asset | Equity | Liability | Expense | Income
24 19--
25data TxAction = Inc | Dec 20-- data TxAction = Inc | Dec
26 21--
27txAopp :: TxAction -> TxAction 22-- txAopp :: TxAction -> TxAction
28txaOpp Inc = Dec 23-- txaOpp Inc = Dec
29txaOpp Dec = Inc 24-- txaOpp Dec = Inc
30 25--
31onDebit :: AccountType -> TxAction 26-- onDebit :: AccountType -> TxAction
32onDebit Asset = Inc 27-- onDebit Asset = Inc
33onDebit Equity = Dec 28-- onDebit Equity = Dec
34onDebit Liability = Dec 29-- onDebit Liability = Dec
35onDebit Expense = Inc 30-- onDebit Expense = Inc
36onDebit Income = Dec 31-- onDebit Income = Dec
37 32--
38onCredit :: AccountType -> TxAction 33-- onCredit :: AccountType -> TxAction
39onCredit = txaOpp . onDebit 34-- onCredit = txaOpp . onDebit
40 35--
41data Ledger = [LedgerEntry] 36-- data Ledger = [LedgerEntry]
42 37--
43data 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.
48data BalAssert = BalAssert { 43-- data BalAssert = BalAssert {
49 amount :: Decimal, 44-- account :: Account,
50 tags :: Tags } 45-- amount :: Decimal,
51 46-- tags :: Tags }
52data 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
61data 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
66data Choice = Red | Blue | Green 61activate :: Adw.Application -> IO ()
67 deriving (Show) 62activate app = do
68 63 button <-
69data 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
75drawUI :: D.Dialog Choice Name -> [Widget Name] 70 `set` [ #sensitive := False,
76drawUI 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 ]
80appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) () 75 button2 <-
81appEvent (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
86appEvent _ = return () 81 ( ?self
82 `set` [ #sensitive := False,
83 #label := "Thanks for clicking me"
84 ]
85 )
86 ]
87 87
88initialState :: D.Dialog Choice Name 88 title <- new Adw.WindowTitle [ #title := "rdcapsis" ]
89initialState = 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
97theMap :: A.AttrMap 126 cond <- Adw.breakpointConditionParse "max-width: 400sp"
98theMap = 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
106theApp :: M.App (D.Dialog Choice Name) e Name 132 window.present
107theApp =
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
116main :: IO () 134main :: IO ()
117main = do 135main = 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)
diff --git a/rdcapsis.cabal b/rdcapsis.cabal
index 5814782..20afc21 100644
--- a/rdcapsis.cabal
+++ b/rdcapsis.cabal
@@ -20,8 +20,6 @@ executable rdcapsis
20 build-depends: 20 build-depends:
21 base ^>=4.20.0.0, 21 base ^>=4.20.0.0,
22 parsec, 22 parsec,
23 brick,
24 vty,
25 cassava, 23 cassava,
26 Decimal, 24 Decimal,
27 text, 25 text,
@@ -32,4 +30,7 @@ executable rdcapsis
32 bytestring, 30 bytestring,
33 regex-tdfa, 31 regex-tdfa,
34 tz, 32 tz,
35 pretty-simple 33 pretty-simple,
34 gi-adwaita,
35 gi-gtk4,
36 haskell-gi-base