fork download
copy 
  1. {-# LANGUAGE MultiParamTypeClasses #-}
  2. {-# LANGUAGE FlexibleContexts #-}
  3. {-# LANGUAGE FlexibleInstances #-}
  4. {-# LANGUAGE FunctionalDependencies #-}
  5. {-# LANGUAGE UndecidableInstances #-}
  6. {-# LANGUAGE OverlappingInstances #-}
  7.  
  8. module Main where
  9.   import qualified Data.Char
  10.   {- 
  11.     Define a Haskell class that describes how OO methods work.
  12.     Basically an OO method takes a number of input variables, the object itself, and returns:
  13.       1. Some output AND/OR
  14.       2. A modified object.
  15.     This is encapulated in the class C below and the function 'ap':
  16.   -}
  17.  
  18.   class C c m i o | m -> i, m -> o where
  19.     ap :: m -> i -> c -> (o, c)
  20.   {- 
  21.     Lets make a data type that represents a user.
  22.     Just first name and last name for the moment 
  23.   -}
  24.  
  25.   data User = User String String
  26.  
  27.   aUser = User "Alice" "Smith"
  28.  
  29.   {- Now, define a GetFirstName method -}
  30.  
  31.   -- We need a dummy data type to put in the 'm' part of the type class.
  32.   data GetFirstName = GetFirstName
  33.  
  34.   -- A get method takes no input and returns a string
  35.  
  36.   -- The implementation. We obviously ignore the dummy method, and the input, 
  37.   -- and return the first name as output, and the object unchanged. 
  38.   instance C User GetFirstName () String where
  39.     ap _ _ u@(User fn _) = (fn, u) 
  40.  
  41.   -- Here's a method that make things easier for our users.
  42.   getFirstName u = fst $ ap (undefined :: GetFirstName) undefined u
  43.  
  44.   {- Lets do a similar thing with PutFirstName -}
  45.  
  46.   data PutFirstName = PutFirstName
  47.  
  48.   instance C User PutFirstName String () where
  49.     ap _ fn (User _ ln) = ((), User fn ln)
  50.  
  51.   putFirstName fn u = snd $ ap (undefined :: PutFirstName) fn u
  52.  
  53.   {-
  54.     We could now do the following to print "Bob", 
  55.     but I've commented it out because I want to do something further:
  56.   -}
  57.   --main = print $ getFirstName $ putFirstName "Bob" aUser
  58.  
  59.   {- Here's a generic way to extend types -}
  60.   data Extend base extension = Extend base extension
  61.  
  62.   -- An existing method on a extended object has the same input and output as the base object
  63.  
  64.   -- If we have a method defined on the base object, it is defined on the extended object also
  65.   instance {-# OVERLAPPABLE #-} C base m i o => C (Extend base ext) m i o where
  66.     ap m in_data (Extend b e) = let (r, nb) = ap m in_data b in (r, Extend nb e)
  67.  
  68.   {- We're going to extend users by adding Age -}
  69.   data Age = Age Int
  70.  
  71.   {- Here's our new type -}
  72.   type ExtendedUser = Extend User Age
  73.  
  74.   aExtendedUser = Extend aUser (Age 42)
  75.  
  76.   {- Lets define a new method -}
  77.   data GetAge = GetAge
  78.  
  79.   instance C ExtendedUser GetAge () Int where
  80.     ap _ _ x@(Extend _ (Age age)) = (age, x)
  81.  
  82.   getAge u = fst $ ap (undefined :: GetAge) undefined u
  83.  
  84.   instance C ExtendedUser GetFirstName () String where
  85.     ap _ _ u@(Extend (User fn _) _) = (map Data.Char.toUpper fn, u)
  86.  
  87.   main = do
  88.     print $ getFirstName $ putFirstName "Bob" aUser
  89.     print $ getAge $ aExtendedUser
  90.     print $ getFirstName $ putFirstName "Bob" aExtendedUser
  91.  
Success #stdin #stdout 0s 4596KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
"Bob"
42
"BOB"
https://ideone.com/znHfSG
language:
Haskell (ghc 8.4.4)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!