{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE UndecidableInstances #-}
--{-# LANGUAGE QualifiedDo #-}
module Symantic.Compta.Norm.PCG.Journal where

import Control.Applicative (Applicative(..), liftA2)
import Control.DeepSeq (NFData)
import Control.Monad (Monad(..), forM)
import Data.Bool
import Data.Decimal (Decimal)
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.), id)
import Data.Functor (Functor, (<$>), (<$))
import Data.Hashable (Hashable)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), maybeToList)
import Data.Monoid (Monoid(..), Endo(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Tuple (uncurry)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import GHC.TypeLits (Symbol)
import Numeric.Natural (Natural)
import Prelude (error)
import Text.Show (Show(..), showString)
import qualified Control.Monad as Monad (Monad(..), forM)
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.Reader as MT
import qualified Control.Monad.Trans.State as MT
import qualified Control.Monad.Trans.Writer as MT
import qualified Data.Char as Char
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import qualified Data.Tree as Tree
import qualified Prelude

import Symantic.Compta.Input.Journal
import Symantic.Compta.Calc.Balance
import Symantic.Compta.Calc.Flow
import Symantic.Compta.Calc.Unit
import Symantic.Compta.Lang
import Symantic.Compta.Norm.PCG.Chart
import Symantic.Compta.Utils.Error
import qualified Symantic.Compta.Calc.Chart as Chart

-- * Type 'JournalPCG'
newtype JournalPCG repr a = JournalPCG { unJournalPCG ::
  MT.Reader (JournalEnv repr) (repr {-Ty (JournalPCG repr)-} a)
  } deriving anyclass (Functor, Applicative, Monad)
type instance Ty (JournalPCG repr) TyAccountSection = Ty repr TyAccountSection
type instance Ty (JournalPCG repr) TyAccount        = Ty repr TyAccount
type instance Ty (JournalPCG repr) TyAmount         = Ty repr TyAmount
type instance Ty (JournalPCG repr) TyUnit           = Ty repr TyUnit
type instance Ty (JournalPCG repr) TyQuantity       = Ty repr TyQuantity

--instance Trans (JournalPCG repr) repr where
  --trans (JournalPCG m) = _e m

journal ::
  IsString (Ty repr TyUnit) =>
  Chart -> JournalRepr (JournalPCG repr) TyMove -> repr [TyMove]
journal ch jnl = MT.runReader (unJournalPCG (runJournalRepr jnl)) (journalEnv ch)

-- ** Type 'JournalEnv'
data JournalEnv (repr::Type -> Type) = JournalEnv
  { journalChart :: Chart
  --, accountByCode :: HashMap.HashMap AccountCode ChartNode
  --, accountByName :: HashMap.HashMap AccountPath (AccountCode, ChartNode)
  , defaultUnit :: Ty repr TyUnit
  }
journalEnv ::
  IsString (Ty repr TyUnit) =>
  Chart -> JournalEnv repr
journalEnv ch = JournalEnv
  { journalChart = ch
  --, accountByCode = HashMap.fromList byCode
  --, accountByName = HashMap.fromList byName
  , defaultUnit = fromString ""
  }
  -- where
  -- (byCode{-, byName-}) = goChart (AccountCode 0{-, []-}) ch
  -- goChart p = Map.foldMapWithKey (goNode p) . Chart.unChart
  -- goNode (AccountCode kc{-, kn-}) n (node, children) =
  --   let keyCode = AccountCode (kc Prelude.* 10 Prelude.^ digitNumber n Prelude.+ n) in
  --   --let keyName = kn <> maybeToList (sectionName node) in
  --   let (bc{-, bn-}) = goChart (keyCode{-, keyName-}) children in
  --   ( (keyCode, ({-nonEmpty keyName,-} node)) : bc
  --   {-
  --   , case nonEmpty keyName of
  --       Just k -> (k, (keyCode, node)) : bn
  --       Nothing -> bn
  --   -}
  --   )

-- | @('digitNumber' n)@ retourne le nombre de digits nécessaires pour encoder 'n'.
digitNumber :: Natural -> Natural
digitNumber = go where
  go n | n < 10 = 1
       | otherwise = 1 Prelude.+ go (n`Prelude.div`10)

instance
  ( Postable repr
  , Listable repr
  ) => IsString (JournalPCG repr TyAccount) where
  fromString = error ""
instance
  ( Postable repr
  , Listable repr
  , Zeroable (repr TyAmount)
  ) => IsString (JournalPCG repr TyPost) where
  fromString s = JournalPCG do
    acct <- unJournalPCG $ fromString s
    return $ post acct zero
instance
  ( Postable repr
  , Listable repr
  , Zeroable (repr TyAmount)
  , Inject (Chart.ChartPath AccountCode) repr TyAccount
  --, FromInteger (JournalPCG repr TyPost)
  ) => FromInteger (JournalPCG repr TyPost) where
  fromInteger i = JournalPCG do
    acct <- unJournalPCG $ fromInteger i
    return $ post acct zero
instance
  Zeroable (repr TyAmount) =>
  Zeroable (JournalPCG repr TyAmount) where
  zero = JournalPCG (return zero)
instance Addable a => Addable (JournalPCG repr a) where
  x + y = (+) <$> x <*> y
instance Listable repr => Listable (JournalPCG repr) where
  nil = JournalPCG (return nil)
  cons (JournalPCG x) (JournalPCG xs) = JournalPCG (liftA2 cons x xs)
  concat (JournalPCG xs) (JournalPCG ys) = JournalPCG (concat <$> xs <*> ys)
instance Postable repr => Postable (JournalPCG repr) where
  post (JournalPCG acct) (JournalPCG amt) = JournalPCG do
    post <$> acct <*> amt
instance
  ( Addable (Ty repr TyQuantity)
  , Moveable repr
  , Negable (Ty repr TyQuantity)
  , Nullable (Ty repr TyQuantity)
  , Ord (Ty repr TyAccountSection)
  , Ord (Ty repr TyUnit)
  , Postable repr
  , Show (Ty repr TyAccountSection)
  , Show (Ty repr TyQuantity)
  , Show (Ty repr TyUnit)
  , Trans repr (BalanceRepr Maybe repr)
  , Trans repr (InferPost repr)
  ) => Moveable (JournalPCG repr) where
  move (JournalPCG ps) = JournalPCG $ go <$> ps
    where
    go ps =
      case equilibrium ps of
        Right eps -> move eps
        Left errs -> error ("equilibrium: "<>show errs)
instance Accountable repr => Accountable (JournalPCG repr) where
  account = JournalPCG . return . account
instance Amountable repr => Amountable (JournalPCG repr) where
  amount = JournalPCG . return . amount
instance Negable (repr qty) => Negable (JournalPCG repr qty) where
  negate = JournalPCG . (negate <$>) . unJournalPCG
{-
instance
  ( Postable repr
  , Listable repr
  ) => Postable acct amt (JournalPCG repr) where
  post acct amt = JournalPCG $ MT.ReaderT $ \_env -> post acct amt
instance
  ( Postable acct (Map unit qty) repr
  , FromInteger (JournalPCG acct (Map unit qty) repr acct)
  , Listable repr
  ) => FromInteger (JournalPCG acct (Map unit qty) repr [TyPost]) where
  fromInteger i = cons (fromInteger i) nil
instance
  ( Postable acct (Map unit qty) repr
  , IsString (JournalPCG acct (Map unit qty) repr acct)
  , Listable repr
  ) => IsString (JournalPCG acct (Map unit qty) repr [TyPost]) where
  fromString s = do
    acct :: acct <- fromString s
    cons (post acct (Map.empty :: Map unit qty)) nil
-}
{-
instance
  ( FromRational qty
  , Listable repr
  ) => FromRational (JournalPCG repr qty) where
  fromRational i = JournalPCG $ MT.ReaderT $ \_env ->
    fromRational i
instance FromInteger (JournalPCG repr AccountCode) where
  fromInteger i = JournalPCG do
    env <- MT.ask
    let ac = if 0 <= i then AccountCode (fromInteger i) else error ("Invalid AccountCode: "<>show i)
    case HashMap.lookup ac (accountByCode env) of
      Just{} -> return ac
      _ -> error ("Chart does not allow AccountCode: "<>show ac<>" "<>show (accountByCode env))
-}
{-
instance
  Listable repr =>
  IsString (JournalPCG repr (Chart.ChartPath AccountSegment)) where
  fromString s = JournalM $ do
    env <- MT.lift MT.ask
    case nonEmpty (fromString s) of
      Just acct | HashMap.member acct (accountByName env) -> return acct
      Just acct -> error ("AccountPath is not allowed by given Chart: "<>show acct)
      Nothing -> error "Invalid empty AccountPath"
instance
  Listable repr =>
  FromInteger (JournalPCG repr (Chart.ChartPath AccountSegment)) where
  fromInteger i = JournalM $ do
    env <- MT.lift MT.ask
    let ac = if 0 <= i then AccountCode (fromInteger i) else error ("Invalid AccountCode: "<>show i)
    case HashMap.lookup ac (accountByCode env) of
      Just (Just acct, _) -> return acct
      _ -> error ("Chart does not allow AccountCode: "<>show ac)
-}
instance
  ( Listable repr
  --, Ty repr TyAccount ~ Chart.ChartPath Natural --AccountCodeSegment
  , Inject (Chart.ChartPath AccountCode) repr TyAccount
  ) => FromInteger (JournalPCG repr TyAccount) where
  fromInteger i = JournalPCG $ do
    env <- MT.ask
    let code = if 0 <= i then fromInteger i else error ("Invalid AccountCode: "<>show code)
    let path = {-chartSection <$>-} NonEmpty.fromList (AccountCode <$> digitsOfNatural code)
    case Chart.lookup path (journalChart env) of
      Just{} -> return $ inject path
      _ -> error ("Chart does not allow AccountCode: "<>show code)
--instance FromInteger qty => FromInteger (JournalPCG repr qty) where
--  fromInteger = JournalPCG . return . fromInteger
--type instance QuantityOf (Map unit qty) = qty
instance
  ( Listable repr
  , Inject (Map (Ty repr TyUnit) (Ty repr TyQuantity)) repr TyAmount
  , FromInteger (Ty repr TyQuantity)
  ) => FromInteger (JournalPCG repr TyAmount) where
  fromInteger i = JournalPCG $ do
    env <- MT.ask
    --qty <- unJournalM (fromInteger i :: JournalPCG acct (Map unit qty) repr qty)
    --q <- unJournalPCG $ fromInteger i
    return $ inject $ Map.singleton (defaultUnit env) (fromInteger i::Ty repr TyQuantity)
instance Unitable (JournalPCG repr) where
  unit u = JournalPCG . MT.local (\env -> env{defaultUnit=u}) . unJournalPCG
instance EURable repr => EURable (JournalPCG repr) where
  eur qty = JournalPCG $ eur <$> unJournalPCG qty
instance USDable repr => USDable (JournalPCG repr) where
  usd qty = JournalPCG $ usd <$> unJournalPCG qty
{-
instance
  Listable repr =>
  IsString (JournalPCG repr AccountCode) where
  fromString s = JournalM $ do
    env <- MT.lift MT.ask
    case nonEmpty (fromString s) of
      Just acct | Just (ac, _) <- HashMap.lookup acct (accountByName env) -> return ac
      Just acct -> error ("AccountPath is not allowed by given Chart: "<>show acct)
      Nothing -> error "Invalid empty AccountPath"
-}


balance :: forall repr a.
  Balanceable a ~ 'True =>
  Addable (Ty repr TyQuantity) =>
  Ord (Ty repr TyAccountSection) =>
  Ord (Ty repr TyUnit) =>
  Trans repr (BalanceRepr Maybe repr) =>
  repr a ->
  Balance (Ty repr TyAccountSection)
          (Ty repr TyUnit)
          (Ty repr TyQuantity)
          (Trickle (Ty (BalanceRepr Trickle repr) TyAmount))
balance =
  runBalanceRepr @Trickle .
  trickleBalanceRepr .
  trans @_ @(BalanceRepr Maybe repr)

{-
instance Listable repr => Listable (JournalPCG repr) where
  nil = Monad.return []
  cons = liftA2 (:)
  concat = liftA2 (<>)
-}

--type instance AccountSectionOf (Chart.ChartPath section) = section
--type instance UnitOf (Map unit qty) = unit
--type instance AmountOf () = Map Unit Q
--type instance AccountOf () = NonEmpty AccountCode

--type Account = AccountCode
--type AccountCodeSegment = AccountCode
--type AccountPath = Chart.ChartPath AccountSegment
--type Amount = Map Unit Q
--type Q = (Flow Decimal)