{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module PrettyPrint (
    Pretty (..),
    printBudget,
) where

import Data.Pos (unP)
import Data.Proxy (Proxy (..))

import GHC.TypeLits

import Prettyprinter

import Budget (Budget, Category (..), IntoRule (..), Rule (MkRule), SomeBudget (..))
import qualified Budget (needs, savings, wants)
import Money (PosMoney, unPosMoney)

instance Pretty Category where
    pretty cat = fill 8 $ viaShow cat <> ":"

instance forall c x z y. (KnownSymbol c, KnownNat x, KnownNat y, KnownNat z) => Pretty (Budget c '(x, y, z)) where
    pretty budget = concatWith (surround hardline) [header, need, want, saving]
      where
        header = "Budget" <+> pretty (toRule budget)
        need = pretty Needs <+> pretty (Budget.needs budget)
        want = pretty Wants <+> pretty (Budget.wants budget)
        saving = pretty Savings <+> pretty (Budget.savings budget)

instance (KnownSymbol c) => Pretty (PosMoney c) where
    pretty x = pretty currency <+> pretty value
      where
        currency = symbolVal x
        value = unP . unPosMoney $ x

instance (KnownNat x, KnownNat y, KnownNat z) => Pretty (Rule '(x, y, z)) where
    pretty x = concatWith (surround "/") . map pretty $ [natVal (Proxy @x), natVal (Proxy @y), natVal (Proxy @z)]

printBudget :: SomeBudget -> Doc ()
printBudget (SomeBudget ss (MkRule n w s) budget) = withKnownNat n $ withKnownNat w $ withKnownNat s $ withKnownSymbol ss (pretty budget)