lcc/Hcompta/LCC/Sym/Subable.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for 'Subable'.
   4 module Hcompta.LCC.Sym.Subable where
   5
   6 import Language.Symantic
   7 import Language.Symantic.Lib (a0)
   8
   9 import Hcompta.Quantity
  10
  11 -- * Class 'Sym_Subable'
  12 type instance Sym (Proxy Subable) = Sym_Subable
  13 class Sym_Subable term where
  14         (-) :: Subable a => term a -> term a -> term a; infixl 6 -
  15         default (-) :: Sym_Subable (UnT term) => Trans term => Subable a => term a -> term a -> term a
  16         (-) = trans2 (-)
  17
  18 instance Sym_Subable Eval where
  19         (-) = eval2 quantity_sub
  20 instance Sym_Subable View where
  21         (-) = viewInfix "-" (infixB SideL 6)
  22 instance (Sym_Subable r1, Sym_Subable r2) => Sym_Subable (Dup r1 r2) where
  23         (-) = dup2 @Sym_Subable (-)
  24 instance (Sym_Subable term, Sym_Lambda term) => Sym_Subable (BetaT term)
  25
  26 instance FixityOf Subable
  27 instance ClassInstancesFor Subable
  28 instance TypeInstancesFor Subable
  29 instance Gram_Term_AtomsFor src ss g Subable
  30 instance (Source src, Inj_Sym ss Subable) => ModuleFor src ss Subable where
  31         moduleFor = ["Subable"] `moduleWhere`
  32          [ "-" `withInfixB` (SideL, 6) := teSubable_sub
  33          ]
  34
  35 tySubable :: Source src => Type src vs a -> Type src vs (Subable a)
  36 tySubable a = tyConstLen @(K Subable) @Subable (lenVars a) `tyApp` a
  37
  38 teSubable_sub :: TermDef Subable '[Proxy a] (Subable a #> (a -> a -> a))
  39 teSubable_sub = Term (tySubable a0) (a0 ~> a0 ~> a0) (teSym @Subable (lam2 (-)))