{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}

module Main where
  import qualified Data.Char
  {- 
    Define a Haskell class that describes how OO methods work.
    Basically an OO method takes a number of input variables, the object itself, and returns:
      1. Some output AND/OR
      2. A modified object.
    This is encapulated in the class C below and the function 'ap':
  -}

  class C c m i o | m -> i, m -> o where
    ap :: m -> i -> c -> (o, c)
  {- 
    Lets make a data type that represents a user.
    Just first name and last name for the moment 
  -}
  
  data User = User String String
  
  aUser = User "Alice" "Smith"
  
  {- Now, define a GetFirstName method -}

  -- We need a dummy data type to put in the 'm' part of the type class.
  data GetFirstName = GetFirstName
  
  -- A get method takes no input and returns a string
  
  -- The implementation. We obviously ignore the dummy method, and the input, 
  -- and return the first name as output, and the object unchanged. 
  instance C User GetFirstName () String where
    ap _ _ u@(User fn _) = (fn, u) 
  
  -- Here's a method that make things easier for our users.
  getFirstName u = fst $ ap (undefined :: GetFirstName) undefined u
  
  {- Lets do a similar thing with PutFirstName -}
  
  data PutFirstName = PutFirstName
  
  instance C User PutFirstName String () where
    ap _ fn (User _ ln) = ((), User fn ln)
    
  putFirstName fn u = snd $ ap (undefined :: PutFirstName) fn u
  
  {-
    We could now do the following to print "Bob", 
    but I've commented it out because I want to do something further:
  -}
  --main = print $ getFirstName $ putFirstName "Bob" aUser
  
  {- Here's a generic way to extend types -}
  data Extend base extension = Extend base extension

  -- An existing method on a extended object has the same input and output as the base object
  
  -- If we have a method defined on the base object, it is defined on the extended object also
  instance {-# OVERLAPPABLE #-} C base m i o => C (Extend base ext) m i o where
    ap m in_data (Extend b e) = let (r, nb) = ap m in_data b in (r, Extend nb e)

  {- We're going to extend users by adding Age -}
  data Age = Age Int
  
  {- Here's our new type -}
  type ExtendedUser = Extend User Age
  
  aExtendedUser = Extend aUser (Age 42)
  
  {- Lets define a new method -}
  data GetAge = GetAge
  
  instance C ExtendedUser GetAge () Int where
    ap _ _ x@(Extend _ (Age age)) = (age, x)
  
  getAge u = fst $ ap (undefined :: GetAge) undefined u
  
  instance C ExtendedUser GetFirstName () String where
    ap _ _ u@(Extend (User fn _) _) = (map Data.Char.toUpper fn, u)
  
  main = do
    print $ getFirstName $ putFirstName "Bob" aUser
    print $ getAge $ aExtendedUser
    print $ getFirstName $ putFirstName "Bob" aExtendedUser