{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module View
  ( viewState
  , viewQuestion
  , viewContext
  , viewSuggestion
  , viewMessage
  ) where

import           Brick
import           Brick.Widgets.List
import           Brick.Widgets.WrappedText
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Hledger as HL

-- hledger-lib 1.17 will switch showTransaction to ISO date format, which means
-- that ISO dates yyyy-mm-dd will be added to the journal instead of yyyy/mm/dd.
--
-- Thus, for hledger-lib >=1.17, we also show the ISO format in the UI
#if !MIN_VERSION_hledger_lib(1,16,99)
import           Data.Time hiding (parseTime)
#endif

import           Model

viewState :: Step -> Widget n
viewState :: forall n. Step -> Widget n
viewState (DateQuestion Text
comment) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
  if Text -> Bool
T.null Text
comment then Text
" " else Text -> Text
viewComment Text
comment
viewState (DescriptionQuestion Day
date Text
comment) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_hledger_lib(1,16,99)
  String -> Text
T.pack (Day -> String
forall a. Show a => a -> String
show Day
date)
#else
  T.pack (formatTime defaultTimeLocale "%Y/%m/%d" date)
#endif
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
viewComment Text
comment
viewState (AccountQuestion Transaction
trans Text
comment) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
  Transaction -> Text
showTransaction Transaction
trans Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
viewComment Text
comment
viewState (AmountQuestion Text
acc Transaction
trans Text
comment) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
  Transaction -> Text
showTransaction Transaction
trans Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
viewComment Text
comment
viewState (FinalQuestion Transaction
trans Bool
_) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
  Transaction -> Text
showTransaction Transaction
trans

viewQuestion :: Step -> Widget n
viewQuestion :: forall n. Step -> Widget n
viewQuestion (DateQuestion Text
_) = Text -> Widget n
forall n. Text -> Widget n
txt Text
"Date"
viewQuestion (DescriptionQuestion Day
_ Text
_) = Text -> Widget n
forall n. Text -> Widget n
txt Text
"Description"
viewQuestion (AccountQuestion Transaction
trans Text
_) = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$
  String
"Account " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Transaction -> Int
numPostings Transaction
trans Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
viewQuestion (AmountQuestion Text
_ Transaction
trans Text
_) = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$
  String
"Amount " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Transaction -> Int
numPostings Transaction
trans Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
viewQuestion (FinalQuestion Transaction
_ Bool
duplicate) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
  Text
"Add this transaction to the journal?"
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
duplicate then Text
" (warning: duplicate)" else Text
"") -- TODO Add better UI for duplicates
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Y/n"

viewContext :: (Ord n, Show n) => List n Text -> Widget n
viewContext :: forall n. (Ord n, Show n) => List n Text -> Widget n
viewContext = (Bool -> Text -> Widget n)
-> Bool -> GenericList n Vector Text -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> Text -> Widget n
forall n. Bool -> Text -> Widget n
renderItem Bool
True

viewSuggestion :: Maybe Text -> Widget n
viewSuggestion :: forall n. Maybe Text -> Widget n
viewSuggestion Maybe Text
Nothing = Text -> Widget n
forall n. Text -> Widget n
txt Text
""
viewSuggestion (Just Text
t) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

renderItem :: Bool -> Text -> Widget n
renderItem :: forall n. Bool -> Text -> Widget n
renderItem Bool
True = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
listSelectedAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt
renderItem Bool
False = Text -> Widget n
forall n. Text -> Widget n
txt

numPostings :: HL.Transaction -> Int
numPostings :: Transaction -> Int
numPostings = [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Posting] -> Int)
-> (Transaction -> [Posting]) -> Transaction -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
HL.tpostings

-- TODO Adding " " to an empty message isn't required for vty >= 5.14
--      => Remove this, once 5.14 becomes lower bound
viewMessage :: Text -> Widget n
viewMessage :: forall n. Text -> Widget n
viewMessage Text
msg = Text -> Widget n
forall n. Text -> Widget n
wrappedText (if Text -> Bool
T.null Text
msg then Text
" " else Text
msg)

viewComment :: Text -> Text
viewComment :: Text -> Text
viewComment Text
comment
  | Text -> Bool
T.null Text
comment = Text
""
  | Bool
otherwise      = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"  ; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
comment


showTransaction :: HL.Transaction -> Text
showTransaction :: Transaction -> Text
showTransaction = Text -> Text
T.stripEnd (Text -> Text) -> (Transaction -> Text) -> Transaction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
HL.showTransaction