]> Git — Sourcephile - comptalang.git/blob - lcc/Hcompta/LCC/Sym/Subable.hs
Remove old Yesod scaffolding.
[comptalang.git] / 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 (-)))