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

import Control.Applicative (Applicative(..))
import Data.Eq (Eq)
import Data.Function (($), (.), id)
import Data.Functor (Functor(..), (<$>))
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Proxy
import Data.Type.Equality ((:~:)(Refl))
import Text.Show (Show(..))
import qualified Data.NonNull as NonNull
import qualified Data.Text as Text
import qualified Prelude ()

import Hcompta.LCC.Account
import Hcompta.LCC.Name
import Language.Symantic
import qualified Language.Symantic.Lib as Sym

-- * Class 'Sym_Account'
class Sym_Account term where
	account :: Account -> term Account
	default account :: Trans t term => Account -> t term Account
	account = trans_lift . account

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

instance Sym_Account HostI where
	account = HostI
instance Sym_Account TextI where
	account a = TextI $ \_p _v ->
		Text.pack (show a)
instance (Sym_Account r1, Sym_Account r2) => Sym_Account (DupI r1 r2) where
	account x = account x `DupI` account x

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

instance Proj_TyFamC cs Sym.TyFam_MonoElement Account

instance -- Proj_TyConC
 ( Proj_TyConst cs Account
 , Proj_TyConsts cs (TyConsts_imported_by (Proxy Account))
 ) => Proj_TyConC cs (Proxy Account) where
	proj_TyConC _ (TyConst q :$ TyConst c)
	 | Just Refl <- eq_skind (kind_of_TyConst c) SKiType
	 , Just Refl <- proj_TyConst c (Proxy @Account)
	 = 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 Account)
 = Token_Term_Account Account
deriving instance (Eq meta, Eq_Token meta ts) => Eq (TokenT meta ts (Proxy Account))
deriving instance (Show meta, Show_Token meta ts) => Show (TokenT meta ts (Proxy Account))

instance -- CompileI
 ( Inj_TyConst cs Account
 -- , Inj_TyConst (TyConsts_of_Ifaces is) (->)
 , Proj_TyCon  cs
 , Compile cs is
 ) => CompileI cs is (Proxy Account) where
	compileI tok _ctx k =
		case tok of
		 Token_Term_Account a -> k (ty @Account) $ TermO $ \_c -> account a
instance -- TokenizeT
 Inj_Token meta ts Account =>
 TokenizeT meta ts (Proxy Account) where
	tokenizeT _t = mempty
instance -- Gram_Term_AtomsT
 ( Alt g
 , Gram_Rule g
 , Gram_Lexer g
 , Gram_Meta meta g
 , Inj_Token meta ts Account
 ) => Gram_Term_AtomsT meta ts (Proxy Account) g where
	gs_term_atomsT _t =
	 [ rule "term_account" $
		lexeme $ metaG $
		(\a meta -> ProTok $ inj_EToken meta $ Token_Term_Account a)
		 <$> g_account
	 ]
		where
		g_account :: CF g Account
		g_account =
			Account . NonNull.impureNonNull
			 <$> some (id <$ char '/' <*> g_account_section)
		g_account_section :: CF g Account_Section
		g_account_section =
			Name . Text.pack
			 <$> some (choice $ unicat <$> [Unicat_Letter])