{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Symantic for 'Transaction'.
module Hcompta.LCC.Sym.Transaction where

import Control.Monad (liftM)
import Data.Eq (Eq)
import Data.Either (Either)
import Data.Function (($), (.))
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Proxy
import Data.Type.Equality ((:~:)(Refl))
import Text.Show (Show(..))
import Data.Map.Strict (Map)
import qualified Prelude ()

import Hcompta.LCC.Account
import Hcompta.LCC.Transaction (Transaction)
import Hcompta.LCC.Posting (Posting, Date, unPostings)
import qualified Hcompta.LCC.Transaction as LCC
import Language.Symantic
import qualified Language.Symantic.Lib as Sym
import Language.Symantic.Lib ((~>))

type Postings = Map Account [Posting]

-- * Class 'Sym_Transaction'
class Sym_Transaction term where
	transaction_date     :: term Transaction -> term Date
	transaction_postings :: term Transaction -> term Postings
	default transaction_date     :: Trans t term => t term Transaction -> t term Date
	default transaction_postings :: Trans t term => t term Transaction -> t term Postings
	transaction_date     = trans_map1 transaction_date
	transaction_postings = trans_map1 transaction_postings

type instance Sym_of_Iface (Proxy Transaction) = Sym_Transaction
type instance TyConsts_of_Iface (Proxy Transaction) = Proxy Transaction ': TyConsts_imported_by (Proxy Transaction)
type instance TyConsts_imported_by (Proxy Transaction) =
 [ Proxy Eq
 , Proxy Show
 ]

instance Sym_Transaction HostI where
	transaction_date     = liftM LCC.transaction_date
	transaction_postings = liftM $ unPostings . LCC.transaction_postings
instance Sym_Transaction TextI where
	transaction_date     = textI1 "transaction_date"
	transaction_postings = textI1 "transaction_postings"
instance (Sym_Transaction r1, Sym_Transaction r2) => Sym_Transaction (DupI r1 r2) where
	transaction_date     = dupI1 @Sym_Transaction transaction_date
	transaction_postings = dupI1 @Sym_Transaction transaction_postings

instance
 ( Read_TyNameR TyName cs rs
 , Inj_TyConst cs Transaction
 ) => Read_TyNameR TyName cs (Proxy Transaction ': rs) where
	read_TyNameR _cs (TyName "Transaction") k = k (ty @Transaction)
	read_TyNameR _rs raw k = read_TyNameR (Proxy @rs) raw k
instance Show_TyConst cs => Show_TyConst (Proxy Transaction ': cs) where
	show_TyConst TyConstZ{} = "Transaction"
	show_TyConst (TyConstS c) = show_TyConst c

instance Proj_TyFamC cs Sym.TyFam_MonoElement Transaction

instance -- Proj_TyConC
 ( Proj_TyConst cs Transaction
 , Proj_TyConsts cs (TyConsts_imported_by (Proxy Transaction))
 ) => Proj_TyConC cs (Proxy Transaction) where
	proj_TyConC _ (TyConst q :$ TyConst c)
	 | Just Refl <- eq_skind (kind_of_TyConst c) SKiType
	 , Just Refl <- proj_TyConst c (Proxy @Transaction)
	 = case () of
		 _ | Just Refl <- proj_TyConst q (Proxy @Eq)   -> Just TyCon
		   | Just Refl <- proj_TyConst q (Proxy @Show) -> Just TyCon
		 _ -> Nothing
	proj_TyConC _c _q = Nothing
data instance TokenT meta (ts::[*]) (Proxy Transaction)
 = Token_Term_Transaction_date
 | Token_Term_Transaction_postings
deriving instance (Eq meta, Eq_Token meta ts) => Eq (TokenT meta ts (Proxy Transaction))
deriving instance (Show meta, Show_Token meta ts) => Show (TokenT meta ts (Proxy Transaction))

instance -- CompileI
 ( Inj_TyConst cs Transaction
 , Inj_TyConst cs (->)
 , Inj_TyConst cs Date
 -- , Inj_TyConst cs Postings
 , Inj_TyConst cs Map
 , Inj_TyConst cs []
 , Inj_TyConst cs Posting
 , Inj_TyConst cs Account
 , Proj_TyCon  cs
 , Compile cs is
 ) => CompileI cs is (Proxy Transaction) where
	compileI
	 :: forall meta ctx ret ls rs.
	 TokenT meta is (Proxy Transaction)
	 -> CompileT meta ctx ret cs is ls (Proxy Transaction ': rs)
	compileI tok _ctx k =
		case tok of
		 Token_Term_Transaction_date     -> get (ty @Date) transaction_date
		 Token_Term_Transaction_postings -> get (ty @Map :$ ty @Account :$ (ty @[] :$ ty @Posting)) transaction_postings
		where
		get
		 :: forall a. Type cs a
		 -> (forall term. Sym_Transaction term => term Transaction -> term a)
		 -> Either (Error_Term meta cs is) ret
		get ty_a op =
			k (ty @Transaction ~> ty_a) $ TermO $
			 \_c -> Sym.lam op
instance -- TokenizeT
 Inj_Token meta ts Transaction =>
 TokenizeT meta ts (Proxy Transaction) where
	tokenizeT _t = mempty
	 { tokenizers_infix = tokenizeTMod []
		 [ tokenize0 "transaction_date"     infixN5 Token_Term_Transaction_date
		 , tokenize0 "transaction_postings" infixN5 Token_Term_Transaction_postings
		 ]
	 }
instance -- Gram_Term_AtomsT
 ( Alt g
 , Gram_Rule g
 , Gram_Lexer g
 , Gram_Meta meta g
 , Inj_Token meta ts Transaction
 ) => Gram_Term_AtomsT meta ts (Proxy Transaction) g where