{-# LANGUAGE NoImplicitPrelude #-}
-- The code for the type class examples
module TypeClassCode where
-- import GHC.Num (showSignedInt)
import qualified Prelude
import Prelude (String, Int, (++), Bool(..), IO, putStrLn, ($), foldr,
zipWith, replicate, (-), getLine, read)
-- We always write signatures, even though they are inferred
-- The simplest type class
-- The standard class Show is a bit more complex and optimized;
-- the main idea is the same though
class Show a where
show :: a -> String
-- The simplest instance
instance Show Bool where
show True = "True"
show False = "False"
instance Show Int where
show x = Prelude.show x -- internal
-- The first parametrically overloaded function
print :: Show a => a -> IO ()
print x = putStrLn $ show x
-- and its instantiation
test_print :: IO ()
test_print = print True
-- Another type class, whose methods follow the other two patterns
-- (one method is binary)
class Num a where
fromInt :: Int -> a -- overloading on the result type
(+) :: a -> a -> a
instance Num Bool where
fromInt 0 = False
fromInt _ = True
True + _ = True
False + x = x
instance Num Int where
fromInt x = x
x + y = (Prelude.+) x y -- internal
-- Another polymorphic function
sum :: Num a => [a] -> a
sum ls = foldr (+) (fromInt 0) ls
test_sum :: Int
test_sum = sum [1, 3, 5]
-- 9
-- A polymorphic function that depends on two constraints
print_incr :: (Show a, Num a) => a -> IO ()
print_incr x = print $ x + fromInt 1
-- Its instantiation. There are no longer constraints
print_incr_int :: Int -> IO ()
print_incr_int x = print_incr x
test_incr :: IO ()
test_incr = print_incr_int 4
-- An instance with a context
instance Show a => Show [a] where
show xs = "[" ++ go True xs
where
go _ [] = "]"
-- using show at a different type
go first (h:t) = (if first then "" else ", ") ++ show h ++ go False t
testls :: String
testls = show [1::Int,2,3]
-- "[1, 2, 3]"
-- Another useful class
class Eq a where
(==) :: a -> a -> Bool
instance Eq Bool where
True == True = True
False == False = True
_ == _ = False
instance Eq Int where
x == y = (Prelude.==) x y -- internal
-- A type class with a super-class and a default method
class (Eq a, Num a) => Mul a where
(*) :: a -> a -> a
x * _ | x == fromInt 0 = fromInt 0
x * y | x == fromInt 1 = y
x * y = y + (x + (fromInt (-1))) * y
instance Mul Bool where
-- default
instance Mul Int where
x * y = (Prelude.*) x y -- internal
-- dot-product. There is only one constraint
dot :: Mul a => [a] -> [a] -> a
dot xs ys = sum $ zipWith (*) xs ys
test_dot :: Int
test_dot = dot [1,2,3] [4,5,6]
-- 32
-- Polymorphic recursion. The signature is mandatory here
print_nested :: Show a => Int -> a -> IO ()
print_nested 0 x = print x
print_nested n x = print_nested (n-1) (replicate n x)
test_nested = do
n <- getLine
print_nested (read n) (5::Int)