{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Symantic for 'Semigroup'. module Language.Symantic.Lib.Semigroup where import Data.Semigroup (Semigroup) import qualified Data.Semigroup as Semigroup import Language.Symantic import Language.Symantic.Lib.Function (a0, b1) import Language.Symantic.Lib.Integral (tyIntegral) -- * Class 'Sym_Semigroup' type instance Sym Semigroup = Sym_Semigroup class Sym_Semigroup term where (<>) :: Semigroup a => term a -> term a -> term a stimes :: (Semigroup a, Integral b) => term b -> term a -> term a -- sconcat :: NonEmpty a -> a default (<>) :: Sym_Semigroup (UnT term) => Trans term => Semigroup a => term a -> term a -> term a default stimes :: Sym_Semigroup (UnT term) => Trans term => Semigroup a => Integral b => term b -> term a -> term a (<>) = trans2 (<>) stimes = trans2 stimes -- Interpreting instance Sym_Semigroup Eval where (<>) = eval2 (Semigroup.<>) stimes = eval2 Semigroup.stimes instance Sym_Semigroup View where (<>) = viewInfix "-" (infixR 6) stimes = view2 "stimes" instance (Sym_Semigroup r1, Sym_Semigroup r2) => Sym_Semigroup (Dup r1 r2) where (<>) = dup2 @Sym_Semigroup (<>) stimes = dup2 @Sym_Semigroup stimes -- Transforming instance (Sym_Semigroup term, Sym_Lambda term) => Sym_Semigroup (BetaT term) -- Typing instance FixityOf Semigroup instance ClassInstancesFor Semigroup instance TypeInstancesFor Semigroup -- Compiling instance Gram_Term_AtomsFor src ss g Semigroup instance (Source src, SymInj ss Semigroup) => ModuleFor src ss Semigroup where moduleFor = ["Semigroup"] `moduleWhere` [ "<>" `withInfixR` 6 := teSemigroup_sappend , "stimes" := teSemigroup_stimes ] -- ** 'Type's tySemigroup :: Source src => Type src vs a -> Type src vs (Semigroup a) tySemigroup a = tyConstLen @(K Semigroup) @Semigroup (lenVars a) `tyApp` a -- ** 'Term's teSemigroup_sappend :: TermDef Semigroup '[Proxy a] (Semigroup a #> (a -> a -> a)) teSemigroup_sappend = Term (tySemigroup a0) (a0 ~> a0 ~> a0) $ teSym @Semigroup $ lam2 (<>) teSemigroup_stimes :: TermDef Semigroup '[Proxy a, Proxy b] (Semigroup a # Integral b #> (b -> a -> a)) teSemigroup_stimes = Term (tySemigroup a0 # tyIntegral b1) (b1 ~> a0 ~> a0) $ teSym @Semigroup $ lam2 stimes