lcc/Hcompta/LCC/Sym/Addable.hs

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