{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoOverloadedLists #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
module Symantic.Compta.Eval where
import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..), sequence)
import Data.Decimal (Decimal)
import Data.Either (Either(..))
import Data.Function (($), (.), id)
import Data.Functor (Functor, (<$>))
import Data.Int (Int)
import Data.Kind
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..), Endo(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Typeable
import Numeric.Natural (Natural)
import Prelude (Enum(..), fromIntegral, Integer)
import Text.Show (Show(..))
import qualified Control.Monad.Classes as MC
import qualified Control.Monad.Trans.Reader as MT
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Time.Calendar as Time
import qualified Data.Tree as Tree

import Symantic.Compta.Utils.Monoid ()
import Symantic.Compta.Lang
import Symantic.Compta.Calc
import Symantic.Compta.Norm.PCG

-- * Type 'Journal'
data Journal a where
  JournalList :: Endo [Journal a] -> Journal [a]
  JournalMove :: Journal [TyPost] -> Journal TyMove
  JournalPost :: Journal TyAccount -> Journal TyAmount -> Journal TyPost
  JournalAccount :: Ty Journal TyAccount -> Journal TyAccount
  JournalAmount :: Ty Journal TyAmount -> Journal TyAmount
deriving instance Show (Journal a)
type instance Ty Journal TyAccount = ChartPath AccountCode
type instance Ty Journal TyAmount = Map Unit (Quantity (Flow Decimal))
type instance Ty Journal TyUnit = Unit
type instance Ty Journal TyQuantity = Quantity (Flow Decimal)
type instance Ty Journal TyAccountSection = AccountCode
instance Inject (ChartPath AccountCode) Journal TyAccount where
  inject = JournalAccount
instance Inject (Map Unit (Quantity (Flow Decimal))) Journal TyAmount where
  inject = JournalAmount
instance Zeroable (Journal TyAmount) where
  zero = JournalAmount zero
instance Negable (Journal TyAmount) where
  negate (JournalAmount x) = JournalAmount (negate x)
instance Negable (Journal TyPost) where
  negate (JournalPost acct amt) = JournalPost acct (negate amt)
instance Negable (Journal TyMove) where
  negate (JournalMove x) = JournalMove (negate x)
instance Negable (Journal a) => Negable (Journal [a]) where
  negate (JournalList x) = JournalList (negate x)
instance Listable Journal where
  nil = JournalList (Endo id)
  cons x (JournalList xs) = JournalList (Endo (x :) <> xs)
  concat (JournalList xs) (JournalList ys) = JournalList (xs <> ys)
instance Accountable Journal where
  account = JournalAccount
instance Amountable Journal where
  amount = JournalAmount
instance Postable Journal where
  post = JournalPost
instance Moveable Journal where
  move = JournalMove
instance
  ( Listable repr
  , Postable repr
  , Moveable repr
  , Inject (Ty Journal TyAccount) repr TyAccount
  , Inject (Ty Journal TyAmount)  repr TyAmount
  ) => Trans Journal repr where
  trans = \case
    JournalList xs -> Foldable.foldr (cons . trans) nil (appEndo xs [])
    JournalMove ps -> move (trans ps)
    JournalPost acct amt -> post (trans acct) (trans amt)
    JournalAccount x -> inject x
    JournalAmount x -> inject x

{-
-- * Eval
data Error
  =  Error_Date Year Month Int
  deriving (Show)
newtype Eval a = Eval { unEval :: Either Error a }
  deriving (Functor, Applicative, Monad, Show)
type instance Account Eval = [String]
type instance Unit Eval = String
type instance Quantity Eval = Decimal
type instance Amount Eval = (Unit Eval, Quantity Eval)
type instance Amounts Eval = Map (Unit Eval) (Quantity Eval)
type instance Date Eval = Time.Day
type instance Wording Eval = String
type instance PolarizedAmount Eval = Decimal
type instance Posting Eval = (Account Eval, Map (Unit Eval) (Quantity Eval))
type instance Transaction Eval =
  ( Date Eval
  , Wording Eval
  , [Posting Eval]
  )
--type instance YearDo (Eval repr) = MT.Reader Year repr
instance Dateable Eval where
  day i kd = \m y -> Eval $
    case Time.fromGregorianValid (fromIntegral y) (fromEnum m) i of
      Nothing -> Left $ Error_Date y m i
      Just d -> unEval (MT.runReaderT kd (Day d))
instance Postingable Eval where
  act -= amts = (,) <$> act <*> amts
  act += amts = (,) <$> act <*> amts
instance Transactionable Eval where
  transaction rw rps = do
    w <- rw
    ps <- sequence rps
    return (w, ps)

type instance Account Eval = [String]
type instance AccountSection Eval = String
type instance Chart Eval = Tree.Tree (String{-, [(String, String)]-})
--type instance Transaction Tree.Tree = Tree (Day, Wording)
--instance Fieldable Eval where
  --x|=v = 
instance Chartable Eval where
  section n ss = Eval (Right ss)
type instance Merge String (Tree.Tree String) = Tree.Tree String
instance Nodable String (Tree.Tree String) Eval where
  sct \= acts = Tree.Node <$> sct <*> sequence acts
    --List.foldr (\a acc -> [Tree.Node a acc]) acts act
  --x ./ y = Tree.Node (Tree.rootLabel x) [y]
  --x .| y = Tree.Node (0,"") [x,y]
-}