Traits, Mixins and Aspect-Oriented Programming in F#

//////////////////////////////////////////////////////////////////
// A compositional type system using generics and monads in F#. //
//////////////////////////////////////////////////////////////////
// A very limited, _toy_ project exploring traits, mixins       //
// and aspect oriented programming                              //
// by Zach Bray (http://www.zbray.com).                         //
//////////////////////////////////////////////////////////////////

(Class monad omitted.)


open System
open TypeSystem

//////////////////////////////////////////////////////////////////
// BASICS                                                       //
//////////////////////////////////////////////////////////////////

// Member symbols are defined as single cases.
type FirstName = |FirstName
type LastName = |LastName
type Name = |Name

// Class constructors are created using the Class monad.
// In this example only 5 members are supported.
let person firstName lastName = Class {
   // Each member function is yielded
   yield function FirstName -> firstName
   yield function LastName -> lastName
   yield function Name -> firstName + " " + lastName
}

// Members symbols can have arguments (and these arguments can be generic).
type 'a AddManager = |AddManager of 'a
type Managers = |Managers

// Class constructors can be generic
let worker<'a>() = Class {
   // Mutable state can be kept inside reference cells.
   let managers = ref List.empty<'a>
   yield function Managers -> !managers
   // A member that takes a parameter
   yield function AddManager newManager -> 
                  managers := newManager :: !managers
}

// Class constructors can be composed
let employee<'a> firstName secondName = Class {
   // We can yield the members of one class...
   yield! person firstName secondName
   // ... then another
   yield! worker<'a>()
}

// We construct instances by passing the parameters into
// the constuctor
let testConstruction =
   let rupert = employee<unit> "Rupert" "Maddog"
   let becca = employee "Becca" "Brooked"
   let dave = employee "Dave" "Kameroon"

   // We access members by using the (/) operator
   becca / AddManager(rupert)
   dave / AddManager(becca)

   for manager in dave / Managers do
      printfn "%s" (manager / Name)


//////////////////////////////////////////////////////////////////
// MIXINS & ADAPTORS                                            //
//////////////////////////////////////////////////////////////////

// Class constructors can also be composed using 
// the (+) operator which allows us to use mixins a la Scala
// http://www.scala-lang.org/node/117

// Iterator members
type HasNext = |HasNext
type Next = |Next

// Rich iterator members
type 'a ForEach = |ForEach of ('a -> unit)

// A rich iterator provides a foreach wrapper
// around the HasNext and Next members
let inline richIterator x = 
   Class {
      yield function ForEach f ->
                     while x / HasNext do
                        f (x / Next)
   }

// Here we construct a basic string iterator
let stringIterator (str:string) = Class {
   let i = ref 0
   yield function HasNext -> !i < str.Length
   yield function Next ->
                  let c = str.[!i]
                  incr i
                  c
}

// Here we construct a mixin of the string iterator
// and the rich iterator
let richStringIterator str =
   let iter = stringIterator str
   // We combine the rich iterator interface with
   // the existing interface here using the (+) operator
   richIterator iter + iter

// We can also choose to use the rich iterator constructor
// as an adaptor rather than a mixin by omitting the
// composition with the original iter
let onlyRichStringIterator str =
   richIterator (stringIterator str)

// We can use either the ForEach member or the HasNext and
// Next members of a richStringIterator to print a string
let testRSI =
   // Using rich interface
   let iter = richStringIterator "Ordered generic parameters suck!"
   iter / ForEach (printf "%c")
   printfn ""

   // Using basic interface
   let iter2 = richStringIterator "Arbitrary metrics suck!"
   while iter2 / HasNext do
      printf "%c" (iter2 / Next)
   printfn ""

// If we use the adapter method we can only use the rich interface
let testORSI =
   // Using rich interface still works!
   let iter = onlyRichStringIterator "Type safety rules!"
   iter / ForEach (printf "%c")
   printfn ""

   // Using basic interface will _not_ compile!
   (*
   let iter2 = onlyRichStringIterator "Type safety rules!"
   while iter2 / HasNext do
      printf "%c" (iter2 / Next)
   printfn ""
   *)

//////////////////////////////////////////////////////////////////
// ASPECT-ORIENTED                                              //
//////////////////////////////////////////////////////////////////

// In addition to adding new members using the (+) operator we
// can also hide members using the (-) operator.

// This means we can do some simple aspect oriented programming
// http://en.wikipedia.org/wiki/Aspect-oriented_programming


// Here we create the interface to a bank account...
type Balance = |Balance
type Deposit = |Deposit of decimal
type Withdraw = |Withdraw of decimal

// ... and its constructor
let account name = Class {
   let balance = ref 0m
   yield function Name -> name
   yield function Balance -> !balance
   yield function Deposit x -> balance := !balance + x
   yield function Withdraw x -> balance := !balance - x
}

// Here we create a helper that will run some code before a given
// member is accessed.
let inline beforeAccess f (property:'a) x =
   Class {
      yield fun (_:'a) ->
         f()
         x / property
   } + (x - property)

// Here we create a function that logs before a property is accessed
let inline logAccess property x =
   x |> beforeAccess (fun () -> printfn "%A Accessed!" property) property

// Here we create a new constructor for an account that logs balance
// requests.
let loggingAccount name =
   account name |> logAccess Balance

let testLoggingAccount =
   let acc = loggingAccount "Zach's current account"
   let illicitFunds = 1000000m
   acc / Deposit illicitFunds
   printfn "Zach's account balance is: %f" (acc / Balance)
   // prints:
   // > Balance Accessed!
   // > Zach's account balance is: 1000000.000000

// We can re-use the same block of code to log when a persons name is accessed.

// Here we create a new constructor for a person that logs when their name
// is accessed
let loggingPerson fName sName =
   person fName sName |> logAccess Name

let testLoggingPerson =
   let zach = loggingPerson "Zach" "Bray"
   printf "My name is: %s" (zach / Name)
   // prints:
   // > Name Accessed!
   // > My name is: Zach Bray

Console.ReadLine() |> ignore<string>