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 | |
| parent | 533ba31d0a03600f57ad46f6e55229a7f2b60994 (diff) | |
| download | rdcapsis-a40d93a36f0dd9f493757d793321f38a58cbb21b.tar.gz rdcapsis-a40d93a36f0dd9f493757d793321f38a58cbb21b.zip | |
Adwaita stuff (pre-destruction commit)
| -rw-r--r-- | app/Main.hs | 239 | ||||
| -rw-r--r-- | rdcapsis.cabal | 7 |
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 | |||
| 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) | ||
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 | ||