From a40d93a36f0dd9f493757d793321f38a58cbb21b Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Thu, 17 Jul 2025 11:33:07 +0200 Subject: Adwaita stuff (pre-destruction commit) --- app/Main.hs | 239 ++++++++++++++++++++++++++++++++---------------------------- 1 file changed, 129 insertions(+), 110 deletions(-) (limited to 'app') 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 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} + 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 Control.Monad (void) +import Data.GI.Base +import GI.Adw qualified as Adw +import GI.Adw.Objects.ApplicationWindow +import GI.Gtk qualified as Gtk 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 () +-- 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 { +-- account :: Account, +-- amount :: Decimal, +-- tags :: Tags } +-- +-- data Tx = Tx { +-- txClearedAt :: Maybe UTCTime, +-- txCommodity :: Commodity, -- the commodity w.r.t. which rates are calculated +-- txDebit :: [(Account, Rate, Amount)], +-- txCredit :: [(Account, Rate, Amount)] +-- -- Description +-- -- Type: +-- } deriving Show +-- +-- data Account = Account { +-- acName :: [T.Text], +-- acBalance :: Amount } + +activate :: Adw.Application -> IO () +activate app = do + button <- + new + Gtk.Button + [ #label := "Click me", + On + #clicked + ( ?self + `set` [ #sensitive := False, + #label := "Thanks for clicking me" + ] + ) + ] + button2 <- + new + Gtk.Button + [ #label := "Click me", + On + #clicked + ( ?self + `set` [ #sensitive := False, + #label := "Thanks for clicking me" + ] + ) + ] -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) + title <- new Adw.WindowTitle [ #title := "rdcapsis" ] + topBar <- new Adw.HeaderBar + [ #titleWidget := title ] + + sidebarToolbarView <- + new Adw.ToolbarView + [ #content := button ] + + mainToolbarView <- + new Adw.ToolbarView + [] + mainToolbarView.addTopBar topBar + + sidebarNavPage <- new Adw.NavigationPage + [ #title := "Accounts", + #tag := "sidebar", + #child := sidebarToolbarView ] + + mainNavPage <- new Adw.NavigationPage + [ #title := "Content", + #tag := "content", + #child := mainToolbarView ] + + splitView <- new Adw.NavigationSplitView + [ #sidebar := sidebarNavPage, + #content := mainNavPage ] + + window <- + new + Adw.ApplicationWindow + [ #application := app, + #content := splitView, + #widthRequest := 280, + #heightRequest := 200, + #defaultWidth := 800, + #defaultHeight := 800 ] -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) - ] + cond <- Adw.breakpointConditionParse "max-width: 400sp" + breakpoint <- new Adw.Breakpoint [ #condition := cond, + On #apply (splitView.setCollapsed True), + On #unapply (splitView.setCollapsed False) ] + window.addBreakpoint breakpoint -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 - } + window.present 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 + app <- + new + Adw.Application + [ #applicationId := "eu.fautchen.rdcapsis", + On #activate (activate ?self) + ] + void $ app.run Nothing --- d <- M.defaultMain theApp initialState --- putStrLn $ "You chose: " <> show (D.dialogSelection d) +-- window <- applicationWindowNew -- cgit v1.2.3