{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fconstraint-solver-iterations=7 #-}
-- | Symantic for 'Quantity'.
module Hcompta.LCC.Sym.Quantity where

-- import Data.Decimal (Decimal)
-- import Control.Applicative (Applicative(..))
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
import Data.Ord (Ord)
import Data.Proxy
-- import Data.Semigroup ((<>))
import Data.Type.Equality ((:~:)(Refl))
import Prelude (Enum, Real)
-- import Text.Read (read)
import Text.Show (Show(..))
import qualified Data.Text as Text
import qualified Language.Symantic.Typing as Sym
import qualified Language.Symantic.Lib as Sym

import Hcompta (Addable, Negable)
import Hcompta.LCC.Amount
import Hcompta.LCC.Read

import Language.Symantic.Parsing
import Language.Symantic.Typing
import Language.Symantic.Compiling
import Language.Symantic.Interpreting
import Language.Symantic.Transforming.Trans

-- * Class 'Sym_Quantity'
class Sym_Quantity term where
	quantity :: Quantity -> term Quantity
	default quantity :: Trans t term => Quantity -> t term Quantity
	quantity = trans_lift . quantity

type instance Sym_of_Iface (Proxy Quantity) = Sym_Quantity
type instance TyConsts_of_Iface (Proxy Quantity) = Proxy Quantity ': TyConsts_imported_by (Proxy Quantity)
type instance TyConsts_imported_by (Proxy Quantity) =
 [ Proxy Addable
 , Proxy Negable
 , Proxy Enum
 , Proxy Eq
 -- , Proxy Fractional
 -- , Proxy Num
 , Proxy Ord
 , Proxy Real
 -- , Proxy RealFrac
 , Proxy Show
 ]

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

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

instance Proj_TyFamC cs Sym.TyFam_MonoElement Quantity

instance -- Proj_TyConC
 ( Proj_TyConst cs Quantity
 , Proj_TyConsts cs (TyConsts_imported_by (Proxy Quantity))
 ) => Proj_TyConC cs (Proxy Quantity) where
	proj_TyConC _ (TyConst q :$ TyConst c)
	 | Just Refl <- eq_skind (kind_of_TyConst c) SKiType
	 , Just Refl <- proj_TyConst c (Proxy @Quantity)
	 = case () of
		 _ | Just Refl <- proj_TyConst q (Proxy @Addable)    -> Just TyCon
		   | Just Refl <- proj_TyConst q (Proxy @Negable)    -> Just TyCon
		   | Just Refl <- proj_TyConst q (Proxy @Enum)       -> Just TyCon
		   | Just Refl <- proj_TyConst q (Proxy @Eq)         -> Just TyCon
		   {- | Just Refl <- proj_TyConst q (Proxy @Fractional) -> Just TyCon -}
		   {- | Just Refl <- proj_TyConst q (Proxy @Num)        -> Just TyCon -}
		   | Just Refl <- proj_TyConst q (Proxy @Ord)        -> Just TyCon
		   | Just Refl <- proj_TyConst q (Proxy @Real)       -> Just TyCon
		   {- | Just Refl <- proj_TyConst q (Proxy @RealFrac)   -> Just TyCon -}
		   | Just Refl <- proj_TyConst q (Proxy @Show)       -> Just TyCon
		 _ -> Nothing
	proj_TyConC _c _q = Nothing
data instance TokenT meta (ts::[*]) (Proxy Quantity)
 = Token_Term_Quantity Quantity
deriving instance Eq_Token meta ts => Eq (TokenT meta ts (Proxy Quantity))
deriving instance Show_Token meta ts => Show (TokenT meta ts (Proxy Quantity))
instance -- CompileI
 Inj_TyConst cs Quantity =>
 CompileI cs is (Proxy Quantity) where
	compileI tok _ctx k =
		case tok of
		 Token_Term_Quantity i -> k (ty @Quantity) $ TermO $ \_c -> quantity i
instance -- TokenizeT
 -- Inj_Token meta ts Quantity =>
 TokenizeT meta ts (Proxy Quantity)
instance -- Gram_Term_AtomsT
 ( Alt g
 , Alter g
 , Gram_Rule g
 , Gram_Lexer g
 , Gram_Meta meta g
 , Gram_Amount g
 , Inj_Token meta ts Quantity
 ) => Gram_Term_AtomsT meta ts (Proxy Quantity) g where
	gs_term_atomsT _t =
	 [ rule "term_quantity" $
		lexeme $ metaG $
		(\(qty, _sty) meta -> ProTok $ inj_EToken meta $ Token_Term_Quantity qty)
		 <$> g_quantity
		 -- <$> some (choice $ char <$> ['0'..'9'])
		 -- <*> option [] ((:) <$> char '.' <*> some (choice $ char <$> ['0'..'9']))
	 ]