{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Symantic for 'Journal'.
module Hcompta.LCC.Sym.Journal 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 qualified Prelude ()

-- import Hcompta.LCC.Account
import Hcompta.LCC.Posting (Date)
import Hcompta.LCC.Journal (Journal, PathFile(..))
import Language.Symantic
import qualified Hcompta.LCC.Journal as LCC
import qualified Language.Symantic.Lib as Sym

-- * Class 'Sym_Journal'
class Sym_Journal term where
	journal                :: Journal j -> term (Journal j)
	journal_file           :: term (Journal j) -> term PathFile
	journal_last_read_time :: term (Journal j) -> term Date
	journal_content        :: term (Journal j) -> term j
	default journal                :: Trans t term => Journal j -> t term (Journal j)
	default journal_file           :: Trans t term => t term (Journal j) -> t term PathFile
	default journal_last_read_time :: Trans t term => t term (Journal j) -> t term Date
	default journal_content        :: Trans t term => t term (Journal j) -> t term j
	journal                = trans_lift . journal
	journal_file           = trans_map1 journal_file
	journal_last_read_time = trans_map1 journal_last_read_time
	journal_content        = trans_map1 journal_content

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

instance Sym_Journal HostI where
	journal                = HostI
	journal_file           = liftM LCC.journal_file
	journal_last_read_time = liftM LCC.journal_last_read_time
	journal_content        = liftM LCC.journal_content
instance Sym_Journal TextI where
	journal _              = TextI $ \_v _p -> "journal"
	journal_file           = textI1 "journal_file"
	journal_last_read_time = textI1 "journal_last_read_time"
	journal_content        = textI1 "journal_content"
instance (Sym_Journal r1, Sym_Journal r2) => Sym_Journal (DupI r1 r2) where
	journal j              = journal j `DupI` journal j
	journal_file           = dupI1 @Sym_Journal journal_file
	journal_last_read_time = dupI1 @Sym_Journal journal_last_read_time
	journal_content        = dupI1 @Sym_Journal journal_content

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

instance Proj_TyFamC cs Sym.TyFam_MonoElement Journal

instance -- Proj_TyConC
 ( Proj_TyConst cs Journal
 , Proj_TyConsts cs (TyConsts_imported_by (Proxy Journal))
 , Proj_TyCon cs
 ) => Proj_TyConC cs (Proxy Journal) where
	proj_TyConC _ (t@(TyConst q) :$ (TyConst c :$ j))
	 | Just Refl <- eq_skind (kind_of_TyConst c) (SKiType `SKiArrow` SKiType)
	 , Just Refl <- proj_TyConst c (Proxy @Journal)
	 = case () of
		 _ | Just Refl  <- proj_TyConst q (Proxy @Eq)
		   , Just TyCon <- proj_TyCon (t :$ j)
		   -> Just TyCon
		   | Just Refl  <- proj_TyConst q (Proxy @Show)
		   , Just TyCon <- proj_TyCon (t :$ j)
		   -> Just TyCon
		 _ -> Nothing
	proj_TyConC _c _q = Nothing
data instance TokenT meta (ts::[*]) (Proxy Journal)
 = Token_Term_Journal_date     (EToken meta ts)
 | Token_Term_Journal_postings (EToken meta ts)
 | Token_Term_Journal_content  (EToken meta ts)
deriving instance (Eq meta, Eq_Token meta ts) => Eq (TokenT meta ts (Proxy Journal))
deriving instance (Show meta, Show_Token meta ts) => Show (TokenT meta ts (Proxy Journal))

instance -- CompileI
 ( Inj_TyConst cs Journal
 , Inj_TyConst cs (->)
 , Inj_TyConst cs PathFile
 , Inj_TyConst cs Date
 , Proj_TyCon  cs
 , Compile cs is
 ) => CompileI cs is (Proxy Journal) where
	compileI
	 :: forall meta ctx ret ls rs.
	 TokenT meta is (Proxy Journal)
	 -> CompileT meta ctx ret cs is ls (Proxy Journal ': rs)
	compileI tok ctx k =
		case tok of
		 Token_Term_Journal_date     tok_j -> get (ty @PathFile) tok_j journal_file
		 Token_Term_Journal_postings tok_j -> get (ty @Date)     tok_j journal_last_read_time
		 Token_Term_Journal_content  tok_jnl ->
			compileO tok_jnl ctx $ \ty_jnl (TermO jnl) ->
			check_TyEq1 (ty @Journal) (At (Just tok_jnl) ty_jnl) $ \Refl ty_j ->
			k ty_j $ TermO $
			 \c -> journal_content (jnl c)
		where
		get
		 :: forall a. Type cs a
		 -> EToken meta is
		 -> (forall term j. Sym_Journal term => term (Journal j) -> term a)
		 -> Either (Error_Term meta cs is) ret
		get ty_a tok_jnl op =
			compileO tok_jnl ctx $ \ty_jnl (TermO jnl) ->
			check_TyEq1 (ty @Journal) (At (Just tok_jnl) ty_jnl) $ \Refl _ty_j ->
			k ty_a $ TermO $
			 \c -> op (jnl c)
instance -- TokenizeT
 Inj_Token meta ts Journal =>
 TokenizeT meta ts (Proxy Journal) where
	tokenizeT _t = mempty
	 { tokenizers_infix = tokenizeTMod []
		 [ tokenize1 "journal_file"           infixN5 Token_Term_Journal_date
		 , tokenize1 "journal_last_read_time" infixN5 Token_Term_Journal_postings
		 , tokenize1 "journal_content"        infixN5 Token_Term_Journal_content
		 ]
	 }
instance -- Gram_Term_AtomsT
 ( Alt g
 , Gram_Rule g
 , Gram_Lexer g
 , Gram_Meta meta g
 , Inj_Token meta ts Journal
 ) => Gram_Term_AtomsT meta ts (Proxy Journal) g where