doc: rename {hut => code}.sourcephile.fr

[haskell/symantic-base.git] / src / Symantic / Class.hs

diff --git a/src/Symantic/Class.hs b/src/Symantic/Class.hs
index 75216a65b4b6a455025aa868ee2a995e66d3ac78..7d5aa776131ab67ec9fa1e4f59f8029c45ab45cd 100644 (file)
--- a/src/Symantic/Class.hs
+++ b/src/Symantic/Class.hs
@@ -8,11 +8,14 @@ import Data.Bool (Bool(..))
 import Data.Char (Char)
 import Data.Either (Either(..))
 import Data.Eq (Eq)
+import Data.Int (Int)
 import Data.Kind (Type)
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Proxy (Proxy(..))
 import Data.Semigroup (Semigroup)
+import Data.String (String)
 import GHC.Generics (Generic)
+import Numeric.Natural (Natural)
 import qualified Control.Category as Cat
 import qualified Data.Function as Fun
 import qualified Data.Tuple as Tuple
@@ -96,13 +99,6 @@ class Constantable c repr where
     FromDerived (Constantable c) repr =>
     c -> repr c
 
-bool :: Constantable Bool repr => Bool -> repr Bool
-bool = constant @Bool
-char :: Constantable Char repr => Char -> repr Char
-char = constant @Char
-unit :: Constantable () repr => repr ()
-unit = constant @() ()
-
 -- * Class 'Eitherable'
 class Eitherable repr where
   left :: repr (l -> Either l r)
@@ -125,8 +121,10 @@ class Equalable repr where
     Eq a => repr (a -> a -> Bool)
 
 infix 4 `equal`, ==
-(==) :: (Abstractable repr, Equalable repr, Eq a) => repr (a -> a -> Bool)
-(==) = lam (\x -> lam (\y -> equal .@ x .@ y))
+(==) ::
+  Abstractable repr => Equalable repr => Eq a =>
+  repr a -> repr a -> repr Bool
+(==) x y = equal .@ x .@ y
 
 -- * Class 'IfThenElseable'
 class IfThenElseable repr where
@@ -136,6 +134,25 @@ class IfThenElseable repr where
     FromDerived3 IfThenElseable repr =>
     repr Bool -> repr a -> repr a -> repr a
 
+-- * Class 'Inferable'
+class Inferable a repr where
+  infer :: repr a
+  default infer :: FromDerived (Inferable a) repr => repr a
+  infer = liftDerived infer
+
+unit :: Inferable () repr => repr ()
+unit = infer
+bool :: Inferable Bool repr => repr Bool
+bool = infer
+char :: Inferable Char repr => repr Char
+char = infer
+int :: Inferable Int repr => repr Int
+int = infer
+natural :: Inferable Natural repr => repr Natural
+natural = infer
+string :: Inferable String repr => repr String
+string = infer
+
 -- * Class 'Listable'
 class Listable repr where
   cons :: repr (a -> [a] -> [a])