{- |
Overview:
hledger-ui's UIState holds the currently active screen and any previously visited
screens (and their states).
The brick App delegates all event-handling and rendering
to the UIState's active screen.
Screens have their own screen state, render function, event handler, and app state
update function, so they have full control.

@
Brick.defaultMain brickapp st
  where
    brickapp :: App (UIState) V.Event
    brickapp = App {
        appLiftVtyEvent = id
      , appStartEvent   = return
      , appAttrMap      = const theme
      , appChooseCursor = showFirstCursor
      , appHandleEvent  = \st ev -> sHandle (aScreen st) st ev
      , appDraw         = \st    -> sDraw   (aScreen st) st
      }
    st :: UIState
    st = (sInit s) d
         UIState{
            aopts=uopts'
           ,ajournal=j
           ,aScreen=s
           ,aPrevScreens=prevscrs
           ,aMinibuffer=Nothing
           }
@
-}

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE EmptyDataDeriving #-}

module Hledger.UI.UITypes where

-- import Control.Concurrent (threadDelay)
-- import GHC.IO (unsafePerformIO)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Brick.Widgets.List (List)
import Brick.Widgets.Edit (Editor)
import Lens.Micro.Platform (makeLenses)
import Text.Show.Functions ()
  -- import the Show instance for functions. Warning, this also re-exports it

import Hledger
import Hledger.Cli (HasCliOpts(..))
import Hledger.UI.UIOptions

data AppEvent =
    FileChange          -- one of the Journal's files has been added/modified/removed
  | DateChange Day Day  -- the current date has changed since last checked (with the old and new values)
  deriving (AppEvent -> AppEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppEvent -> AppEvent -> Bool
$c/= :: AppEvent -> AppEvent -> Bool
== :: AppEvent -> AppEvent -> Bool
$c== :: AppEvent -> AppEvent -> Bool
Eq, Int -> AppEvent -> ShowS
[AppEvent] -> ShowS
AppEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppEvent] -> ShowS
$cshowList :: [AppEvent] -> ShowS
show :: AppEvent -> String
$cshow :: AppEvent -> String
showsPrec :: Int -> AppEvent -> ShowS
$cshowsPrec :: Int -> AppEvent -> ShowS
Show)

-- | hledger-ui's application state. This holds one or more stateful screens.
-- As you navigate through screens, the old ones are saved in a stack.
-- The app can be in one of several modes: normal screen operation,
-- showing a help dialog, entering data in the minibuffer etc.
data UIState = UIState {
    -- unchanging:
   UIState -> UIOpts
astartupopts  :: UIOpts    -- ^ the command-line options and query arguments specified at program start
    -- can change while program runs:
  ,UIState -> UIOpts
aopts         :: UIOpts    -- ^ the command-line options and query arguments currently in effect
  ,UIState -> Journal
ajournal      :: Journal   -- ^ the journal being viewed (can change with --watch)
  ,UIState -> [Screen]
aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first (XXX silly, reverse these)
  ,UIState -> Screen
aScreen      :: Screen   -- ^ the currently active screen
  ,UIState -> Mode
aMode         :: Mode      -- ^ the currently active mode on the current screen
  } deriving (Int -> UIState -> ShowS
[UIState] -> ShowS
UIState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UIState] -> ShowS
$cshowList :: [UIState] -> ShowS
show :: UIState -> String
$cshow :: UIState -> String
showsPrec :: Int -> UIState -> ShowS
$cshowsPrec :: Int -> UIState -> ShowS
Show)

-- | Any screen can be in one of several modes, which modifies 
-- its rendering and event handling.
-- The mode resets to Normal when entering a new screen.
data Mode =
    Normal
  | Help
  | Minibuffer Text (Editor String Name)
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show,Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq)

-- Ignore the editor when comparing Modes.
instance Eq (Editor l n) where Editor l n
_ == :: Editor l n -> Editor l n -> Bool
== Editor l n
_ = Bool
True

-- Unique names required for brick widgets, viewports, cursor locations etc.
data Name =
    HelpDialog
  | MinibufferEditor
  | MenuList
  | AccountsViewport
  | AccountsList
  | RegisterViewport
  | RegisterList
  | TransactionEditor
  deriving (Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq)

-- Unique names for screens the user can navigate to from the menu.
data ScreenName =
    Accounts
  | CashScreen
  | Balancesheet
  | Incomestatement
  deriving (Eq ScreenName
ScreenName -> ScreenName -> Bool
ScreenName -> ScreenName -> Ordering
ScreenName -> ScreenName -> ScreenName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScreenName -> ScreenName -> ScreenName
$cmin :: ScreenName -> ScreenName -> ScreenName
max :: ScreenName -> ScreenName -> ScreenName
$cmax :: ScreenName -> ScreenName -> ScreenName
>= :: ScreenName -> ScreenName -> Bool
$c>= :: ScreenName -> ScreenName -> Bool
> :: ScreenName -> ScreenName -> Bool
$c> :: ScreenName -> ScreenName -> Bool
<= :: ScreenName -> ScreenName -> Bool
$c<= :: ScreenName -> ScreenName -> Bool
< :: ScreenName -> ScreenName -> Bool
$c< :: ScreenName -> ScreenName -> Bool
compare :: ScreenName -> ScreenName -> Ordering
$ccompare :: ScreenName -> ScreenName -> Ordering
Ord, Int -> ScreenName -> ShowS
[ScreenName] -> ShowS
ScreenName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScreenName] -> ShowS
$cshowList :: [ScreenName] -> ShowS
show :: ScreenName -> String
$cshow :: ScreenName -> String
showsPrec :: Int -> ScreenName -> ShowS
$cshowsPrec :: Int -> ScreenName -> ShowS
Show, ScreenName -> ScreenName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScreenName -> ScreenName -> Bool
$c/= :: ScreenName -> ScreenName -> Bool
== :: ScreenName -> ScreenName -> Bool
$c== :: ScreenName -> ScreenName -> Bool
Eq)

----------------------------------------------------------------------------------------------------
-- | hledger-ui screen types, v1, "one screen = one module"
-- These types aimed for maximum decoupling of modules and ease of adding more screens.
-- A new screen requires
-- 1. a new constructor in the Screen type, 
-- 2. a new module implementing init/draw/handle functions, 
-- 3. a call from any other screen which enters it.
-- Each screen type has generically named initialisation, draw, and event handling functions,
-- and zero or more uniquely named screen state fields, which hold the data for a particular
-- instance of this screen. Note the latter create partial functions, which means that some invalid
-- cases need to be handled, and also that their lenses are traversals, not single-value getters.
-- data Screen =
--     AccountsScreen {
--        sInit   :: Day -> Bool -> UIState -> UIState              -- ^ function to initialise or update this screen's state
--       ,sDraw   :: UIState -> [Widget Name]                             -- ^ brick renderer for this screen
--       ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()  -- ^ brick event handler for this screen
--       -- state fields.These ones have lenses:
--       ,_asList            :: List Name AccountsScreenItem  -- ^ list widget showing account names & balances
--       ,_asSelectedAccount :: AccountName              -- ^ a backup of the account name from the list widget's selected item (or "")
--     }
--   | RegisterScreen {
--        sInit   :: Day -> Bool -> UIState -> UIState
--       ,sDraw   :: UIState -> [Widget Name]
--       ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
--       --
--       ,rsList    :: List Name RegisterScreenItem      -- ^ list widget showing transactions affecting this account
--       ,rsAccount :: AccountName                       -- ^ the account this register is for
--       ,rsForceInclusive :: Bool                       -- ^ should this register always include subaccount transactions,
--                                                       --   even when in flat mode ? (ie because entered from a
--                                                       --   depth-clipped accounts screen item)
--     }
--   | TransactionScreen {
--        sInit   :: Day -> Bool -> UIState -> UIState
--       ,sDraw   :: UIState -> [Widget Name]
--       ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
--       --
--       ,tsTransaction  :: NumberedTransaction          -- ^ the transaction we are currently viewing, and its position in the list
--       ,tsTransactions :: [NumberedTransaction]        -- ^ list of transactions we can step through
--       ,tsAccount      :: AccountName                  -- ^ the account whose register we entered this screen from
--     }
--   | ErrorScreen {
--        sInit   :: Day -> Bool -> UIState -> UIState
--       ,sDraw   :: UIState -> [Widget Name]
--       ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
--       --
--       ,esError :: String                              -- ^ error message to show
--     }
--   deriving (Show)

----------------------------------------------------------------------------------------------------
-- | hledger-ui screen types, v2, "more parts, but simpler parts"
-- These types aim to be more restrictive, allowing fewer invalid states, and easier to inspect
-- and debug. The screen types store only state, not behaviour (functions), and there is no longer
-- a circular dependency between UIState and Screen.
-- A new screen requires
-- 1. a new constructor in the Screen type
-- 2. a new screen state type if needed
-- 3. a new case in toAccountsLikeScreen if needed
-- 4. new cases in the uiDraw and uiHandle functions
-- 5. new constructor and updater functions in UIScreens, and a new case in screenUpdate
-- 6. a new module implementing draw and event-handling functions
-- 7. a call from any other screen which enters it (eg the menu screen, a new case in msEnterScreen)
-- 8. if it appears on the main menu: a new menu item in msNew

-- cf https://github.com/jtdaugherty/brick/issues/379#issuecomment-1192000374
-- | The various screens which a user can navigate to in hledger-ui,
-- along with any screen-specific parameters or data influencing what they display.
-- (The separate state types add code noise but seem to reduce partial code/invalid data a bit.)
data Screen =
    MS MenuScreenState
  | AS AccountsScreenState
  | CS AccountsScreenState
  | BS AccountsScreenState
  | IS AccountsScreenState
  | RS RegisterScreenState
  | TS TransactionScreenState
  | ES ErrorScreenState
  deriving (Int -> Screen -> ShowS
[Screen] -> ShowS
Screen -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Screen] -> ShowS
$cshowList :: [Screen] -> ShowS
show :: Screen -> String
$cshow :: Screen -> String
showsPrec :: Int -> Screen -> ShowS
$cshowsPrec :: Int -> Screen -> ShowS
Show)

-- | A subset of the screens which reuse the account screen's state and logic.
-- Such Screens can be converted to and from this more restrictive type
-- for cleaner code.
data AccountsLikeScreen = ALS (AccountsScreenState -> Screen) AccountsScreenState
  deriving (Int -> AccountsLikeScreen -> ShowS
[AccountsLikeScreen] -> ShowS
AccountsLikeScreen -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountsLikeScreen] -> ShowS
$cshowList :: [AccountsLikeScreen] -> ShowS
show :: AccountsLikeScreen -> String
$cshow :: AccountsLikeScreen -> String
showsPrec :: Int -> AccountsLikeScreen -> ShowS
$cshowsPrec :: Int -> AccountsLikeScreen -> ShowS
Show)

toAccountsLikeScreen :: Screen -> Maybe AccountsLikeScreen
toAccountsLikeScreen :: Screen -> Maybe AccountsLikeScreen
toAccountsLikeScreen Screen
scr = case Screen
scr of
  AS AccountsScreenState
ass -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (AccountsScreenState -> Screen)
-> AccountsScreenState -> AccountsLikeScreen
ALS AccountsScreenState -> Screen
AS AccountsScreenState
ass
  CS AccountsScreenState
ass -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (AccountsScreenState -> Screen)
-> AccountsScreenState -> AccountsLikeScreen
ALS AccountsScreenState -> Screen
CS AccountsScreenState
ass
  BS AccountsScreenState
ass -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (AccountsScreenState -> Screen)
-> AccountsScreenState -> AccountsLikeScreen
ALS AccountsScreenState -> Screen
BS AccountsScreenState
ass
  IS AccountsScreenState
ass -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (AccountsScreenState -> Screen)
-> AccountsScreenState -> AccountsLikeScreen
ALS AccountsScreenState -> Screen
IS AccountsScreenState
ass
  Screen
_      -> forall a. Maybe a
Nothing

fromAccountsLikeScreen :: AccountsLikeScreen -> Screen
fromAccountsLikeScreen :: AccountsLikeScreen -> Screen
fromAccountsLikeScreen (ALS AccountsScreenState -> Screen
scons AccountsScreenState
ass) = AccountsScreenState -> Screen
scons AccountsScreenState
ass

data MenuScreenState = MSS {
    -- view data:
   MenuScreenState -> List Name MenuScreenItem
_mssList            :: List Name MenuScreenItem  -- ^ list widget showing screen names
  ,MenuScreenState -> ()
_mssUnused          :: ()                        -- ^ dummy field to silence warning
} deriving (Int -> MenuScreenState -> ShowS
[MenuScreenState] -> ShowS
MenuScreenState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MenuScreenState] -> ShowS
$cshowList :: [MenuScreenState] -> ShowS
show :: MenuScreenState -> String
$cshow :: MenuScreenState -> String
showsPrec :: Int -> MenuScreenState -> ShowS
$cshowsPrec :: Int -> MenuScreenState -> ShowS
Show)

-- Used for the accounts screen and similar screens.
data AccountsScreenState = ASS {
    -- screen parameters:
   AccountsScreenState -> Text
_assSelectedAccount :: AccountName                   -- ^ a copy of the account name from the list's selected item (or "")
    -- view data derived from options, reporting date, journal, and screen parameters:
  ,AccountsScreenState -> List Name AccountsScreenItem
_assList            :: List Name AccountsScreenItem  -- ^ list widget showing account names & balances
} deriving (Int -> AccountsScreenState -> ShowS
[AccountsScreenState] -> ShowS
AccountsScreenState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountsScreenState] -> ShowS
$cshowList :: [AccountsScreenState] -> ShowS
show :: AccountsScreenState -> String
$cshow :: AccountsScreenState -> String
showsPrec :: Int -> AccountsScreenState -> ShowS
$cshowsPrec :: Int -> AccountsScreenState -> ShowS
Show)

data RegisterScreenState = RSS {
    -- screen parameters:
   RegisterScreenState -> Text
_rssAccount        :: AccountName                    -- ^ the account this register is for
  ,RegisterScreenState -> Bool
_rssForceInclusive :: Bool                           -- ^ should this register always include subaccount transactions,
                                                        --   even when in flat mode ? (ie because entered from a
                                                        --   depth-clipped accounts screen item)
    -- view data derived from options, reporting date, journal, and screen parameters:
  ,RegisterScreenState -> List Name RegisterScreenItem
_rssList           :: List Name RegisterScreenItem   -- ^ list widget showing transactions affecting this account
} deriving (Int -> RegisterScreenState -> ShowS
[RegisterScreenState] -> ShowS
RegisterScreenState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterScreenState] -> ShowS
$cshowList :: [RegisterScreenState] -> ShowS
show :: RegisterScreenState -> String
$cshow :: RegisterScreenState -> String
showsPrec :: Int -> RegisterScreenState -> ShowS
$cshowsPrec :: Int -> RegisterScreenState -> ShowS
Show)

data TransactionScreenState = TSS {
    -- screen parameters:
   TransactionScreenState -> Text
_tssAccount      :: AccountName                  -- ^ the account whose register we entered this screen from
  ,TransactionScreenState -> [NumberedTransaction]
_tssTransactions :: [NumberedTransaction]        -- ^ the transactions in that register, which we can step through
  ,TransactionScreenState -> NumberedTransaction
_tssTransaction  :: NumberedTransaction          -- ^ the currently displayed transaction, and its position in the list
} deriving (Int -> TransactionScreenState -> ShowS
[TransactionScreenState] -> ShowS
TransactionScreenState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionScreenState] -> ShowS
$cshowList :: [TransactionScreenState] -> ShowS
show :: TransactionScreenState -> String
$cshow :: TransactionScreenState -> String
showsPrec :: Int -> TransactionScreenState -> ShowS
$cshowsPrec :: Int -> TransactionScreenState -> ShowS
Show)

data ErrorScreenState = ESS {
    -- screen parameters:
   ErrorScreenState -> String
_essError :: String                              -- ^ error message to show
  ,ErrorScreenState -> ()
_essUnused :: ()                                 -- ^ dummy field to silence warning
} deriving (Int -> ErrorScreenState -> ShowS
[ErrorScreenState] -> ShowS
ErrorScreenState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorScreenState] -> ShowS
$cshowList :: [ErrorScreenState] -> ShowS
show :: ErrorScreenState -> String
$cshow :: ErrorScreenState -> String
showsPrec :: Int -> ErrorScreenState -> ShowS
$cshowsPrec :: Int -> ErrorScreenState -> ShowS
Show)

-- | An item in the menu screen's list of screens.
data MenuScreenItem = MenuScreenItem {
   MenuScreenItem -> Text
msItemScreenName :: Text                         -- ^ screen display name
  ,MenuScreenItem -> ScreenName
msItemScreen     :: ScreenName                   -- ^ an internal name we can use to find the corresponding screen
  } deriving (Int -> MenuScreenItem -> ShowS
[MenuScreenItem] -> ShowS
MenuScreenItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MenuScreenItem] -> ShowS
$cshowList :: [MenuScreenItem] -> ShowS
show :: MenuScreenItem -> String
$cshow :: MenuScreenItem -> String
showsPrec :: Int -> MenuScreenItem -> ShowS
$cshowsPrec :: Int -> MenuScreenItem -> ShowS
Show)

-- | An item in the accounts screen's list of accounts and balances.
data AccountsScreenItem = AccountsScreenItem {
   AccountsScreenItem -> Int
asItemIndentLevel        :: Int                -- ^ indent level
  ,AccountsScreenItem -> Text
asItemAccountName        :: AccountName        -- ^ full account name
  ,AccountsScreenItem -> Text
asItemDisplayAccountName :: AccountName        -- ^ full or short account name to display
  ,AccountsScreenItem -> Maybe MixedAmount
asItemMixedAmount        :: Maybe MixedAmount  -- ^ mixed amount to display
  } deriving (Int -> AccountsScreenItem -> ShowS
[AccountsScreenItem] -> ShowS
AccountsScreenItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountsScreenItem] -> ShowS
$cshowList :: [AccountsScreenItem] -> ShowS
show :: AccountsScreenItem -> String
$cshow :: AccountsScreenItem -> String
showsPrec :: Int -> AccountsScreenItem -> ShowS
$cshowsPrec :: Int -> AccountsScreenItem -> ShowS
Show)

-- | An item in the register screen's list of transactions in the current account.
data RegisterScreenItem = RegisterScreenItem {
   RegisterScreenItem -> Text
rsItemDate           :: Text         -- ^ date
  ,RegisterScreenItem -> Status
rsItemStatus         :: Status       -- ^ transaction status
  ,RegisterScreenItem -> Text
rsItemDescription    :: Text         -- ^ description
  ,RegisterScreenItem -> Text
rsItemOtherAccounts  :: Text         -- ^ other accounts
  ,RegisterScreenItem -> WideBuilder
rsItemChangeAmount   :: WideBuilder  -- ^ the change to the current account from this transaction
  ,RegisterScreenItem -> WideBuilder
rsItemBalanceAmount  :: WideBuilder  -- ^ the balance or running total after this transaction
  ,RegisterScreenItem -> Transaction
rsItemTransaction    :: Transaction  -- ^ the full transaction
  }
  deriving (Int -> RegisterScreenItem -> ShowS
[RegisterScreenItem] -> ShowS
RegisterScreenItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterScreenItem] -> ShowS
$cshowList :: [RegisterScreenItem] -> ShowS
show :: RegisterScreenItem -> String
$cshow :: RegisterScreenItem -> String
showsPrec :: Int -> RegisterScreenItem -> ShowS
$cshowsPrec :: Int -> RegisterScreenItem -> ShowS
Show)

type NumberedTransaction = (Integer, Transaction)

-- These TH calls must come after most of the types above.
-- Fields named _foo produce lenses named foo.
-- XXX foo fields producing fooL lenses would be preferable
makeLenses ''MenuScreenState
makeLenses ''AccountsScreenState
makeLenses ''RegisterScreenState
makeLenses ''TransactionScreenState
makeLenses ''ErrorScreenState

----------------------------------------------------------------------------------------------------

-- | Error message to use in case statements adapting to the different Screen shapes.
errorWrongScreenType :: String -> a
errorWrongScreenType :: forall a. String -> a
errorWrongScreenType String
lbl =
  -- unsafePerformIO $ threadDelay 2000000 >>  -- delay to allow console output to be seen
  forall a. String -> a
error' ([String] -> String
unwords [String
lbl, String
"called with wrong screen type, should not happen"])

-- dummy monoid instance needed make lenses work with List fields not common across constructors
--instance Monoid (List n a)
--  where
--    mempty        = list "" V.empty 1  -- XXX problem in 0.7, every list requires a unique Name
--    mappend l1 l = l1 & listElementsL .~ (l1^.listElementsL <> l^.listElementsL)

uioptslens :: (UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslens UIOpts -> f UIOpts
f UIState
ui = (\UIOpts
x -> UIState
ui{aopts :: UIOpts
aopts=UIOpts
x}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIOpts -> f UIOpts
f (UIState -> UIOpts
aopts UIState
ui)

instance HasCliOpts UIState where
    cliOpts :: Lens' UIState CliOpts
cliOpts = forall {f :: * -> *}.
Functor f =>
(UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall c. HasCliOpts c => Lens' c CliOpts
cliOpts

instance HasInputOpts UIState where
    inputOpts :: Lens' UIState InputOpts
inputOpts = forall {f :: * -> *}.
Functor f =>
(UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall c. HasInputOpts c => Lens' c InputOpts
inputOpts

instance HasBalancingOpts UIState where
    balancingOpts :: Lens' UIState BalancingOpts
balancingOpts = forall {f :: * -> *}.
Functor f =>
(UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall c. HasBalancingOpts c => Lens' c BalancingOpts
balancingOpts

instance HasReportSpec UIState where
    reportSpec :: Lens' UIState ReportSpec
reportSpec = forall {f :: * -> *}.
Functor f =>
(UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall c. HasReportSpec c => Lens' c ReportSpec
reportSpec

instance HasReportOptsNoUpdate UIState where
    reportOptsNoUpdate :: Lens' UIState ReportOpts
reportOptsNoUpdate = forall {f :: * -> *}.
Functor f =>
(UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall c. HasReportOptsNoUpdate c => Lens' c ReportOpts
reportOptsNoUpdate

instance HasReportOpts UIState where
    reportOpts :: ReportableLens' UIState ReportOpts
reportOpts = forall {f :: * -> *}.
Functor f =>
(UIOpts -> f UIOpts) -> UIState -> f UIState
uioptslensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. HasReportOpts a => ReportableLens' a ReportOpts
reportOpts