--[[ Movable and Named Objects on the Cartesian Plane
     H. Conrad Cunningham, Professor
     Computer and Information Science
     University of Mississippi

This case study examines issues related to the design and
implementation of inheritance hierarchies and multiple inheritance in
Lua.  It is based on a similar Haskell case study given in Section
14.6 of the textbook:

    Simon Thompson. Haskell: The Craft of Functional Programming,
    Third Edition, Addison Wesley, 2011.

Developed for CSci 658, Software Language Engineering, Fall 2013

1234567890123456789012345678901234567890123456789012345678901234567890

2013-10-03: Completed prototype (late evening after class)

Note: See the improved modularized version of this package.

The class structure for code in this case study is as follows.
Indentation indicates subclasses.

  concrete class Vector
  abstract class Movable
      concrete subclass Point
      abstract subclass Figure
          concrete subclass Line
          concrete subclass Circle
      concrete subclass MovableList
      concrete class NamedMovable (ALSO UNDER Name)
  abstract class Named
      concrete subclass Name
          concrete class NamedMovable

--]]

-- Type tag constants for the classes in this package
local VECTOR       = "Vector"
local MOVABLE      = "Movable"
local POINT        = "Point"
local FIGURE       = "Figure"
local LINE         = "Line"
local CIRCLE       = "Circle"
local MOVABLELIST  = "MovableList"
local NAMED        = "Named"
local NAME         = "Name"
local MOVABLENAME  = "MovableName"


-- Functions for creating and testing single and multiple inheritance
-- class structures

-- Function "makeConstructor" returns a standard default constructor
-- method for the classes in this package.  For example, assigning
-- the returned value to ClassName.new to build a constructor method
-- ClassName:new(o) for some object (table) "o" in "ClassName".

local function makeConstructor()
  return 
    function(self,o)
      o = o or {}
      setmetatable(o,self)
      self.__index = self
      return o
    end
end

-- Function "search" searches the tables in "plist" in order for a key
-- "k".  If it finds "k", it returns the corresponding entry.  If not
-- found, it returns nil. Based on code in Listing 16.1 of the 3rd
-- edition of the PiL book.

local function search(k,plist)
  for i = 1,#plist do
    local v = plist[i][k]
    if v then return v end
  end
  return nil
end

-- Function "makeClass" returns the prototype object (table) for a
-- class with the given type tag "classTag" and the zero or more
-- superclass objects given as the remaining arguments.  This function
-- is, in part, adapted from the "createClass" method in Listing 16.1
-- of the 3rd edition of the PiL book.

-- (1) If no superclasses are given, then the returned class is a base
--     class with no parents. A standard default constructor is
--     created for the new class.

-- (2) If one superclass is given, then the returned class is a
--     subclass of that class.  That parent's constructor should be
--     used to create instances of the new class.

-- (3) If more than one superclass is given, then the returned class
--     has multiple parents.  A default constructor with multiple
--     inheritance is created for the new class.

local function makeClass(classTag,...)
  assert(type(classTag) == "string",
         "Function makeClass called with invalid class tag.")
  local parents = {...}
  local c       = { tag = classTag }
  if #parents == 0 then
     c.new = makeConstructor()
     return c
  elseif #parents == 1 then  -- single inheritance
    local parentObj = parents[1]
    assert(type(parentObj) == "table" and parentObj:getTag(),
           "Function makeClass called with invalid parent object.")
    return parentObj:new { tag = classTag, super = parents }
  else  -- multiple inheritance
    local parentObj 
    for i = 1, #parents do -- all parents must be valid
      parentObj = parents[i]
      assert(type(parentObj) == "table" and parentObj:getTag(),
             "Function makeClass called with invalid parent object.")
    end
    c.super = parents
    -- search method list for each parent in turn
    local mt = { __index = function(t,k)
                             return search(k,c.super)
                           end }
    -- make c metatable for its instances
    setmetatable(c,mt)
    c.__index = c
    c.new     = makeConstructor()
    return c
  end
end
    
-- Function "isInstanceOf" returns true iff argument "obj" is an
-- instance of the class whose tag is given in argument "class" or an
-- instance of one of its subclasses.

local function isInstanceOf(obj,class)
  if type(obj) ~= "table" or type(class) ~= "string" then
    return false
  elseif obj:getTag() == class then 
    return true
  elseif obj:getSuper() then
    local super = obj:getSuper()
    for i = 1, #super do
      if isInstanceOf(super[i],class) then return true end
    end
    return false
  else
    return false
  end
end

-- Function "map" applies function "f" to every element of array-style
-- table "t" and returns a new table holding the values.
-- NOT CURRENTLY USED

local function map(f,t)
  assert(type(f) == "function",
         "First argument of map must be a single-argument function.")
  assert(type(t) == "table",
         "Second argument of map must be an array-style table.")
  local newt = {}
  for i = 1, #t do
    newt[i] = f(t[i])
  end
  return newt
end


--[[ CONCRETE CLASS Vector prototype

An object of the "Vector" class represents a displacement on the
Cartesian plane.  It has two fields: the "x" (horizontal) and "y"
(vertical) components of the displacement.

The Haskell definition for the Vector algebraic data type is: 

    data Vector = Vec Float Float

--]]

local Vector = makeClass(VECTOR)

-- Vector factory (constructor/initializer) method
function Vector:make(xc,yc)
  assert(type(xc) == "number" and type(yc) == "number",
         "Vector objects must have numeric x and y coordinates.")
  local o = { x = xc, y = yc }
  return Vector:new(o)
end

-- Vector accessors
function Vector:getTag() return self.tag end
function Vector:getX()   return self.x   end
function Vector:getY()   return self.y   end

function Vector:toString()
  return tostring(self:getTag()) .. "(" .. 
         tostring(self:getX()) .. ", " .. 
         tostring(self:getY()) .. ")"
end


--[[ ABSTRACT CLASS Movable prototype

Movable objects represent entities that can be moved on the Cartesian
plane. The Haskell class declaration for Movable is as follows:

     class Movable a where
       move      :: Vector -> a -> a
       reflectX  :: a -> a
       reflectY  :: a -> a
       rotate180 :: a -> a
       rotate180 = reflectX . reflectY

The Lua code makes "move" a one-parameter mutator method and
"reflectX", "reflectY", and "rotate180" parameterless mutator methods.
The Movable object (i.e., the first parameter of the Haskell
functions) is the implicit parameter (i.e., the receiver or target of
the method).

--]]

local Movable = makeClass(MOVABLE)

-- Accessors
function Movable:getTag()   return self.tag   end
function Movable:getSuper() return self.super end

-- Deferred "hook" method "display" is used by method "toString" to
-- display the body of the string.  It must be implemented
-- appropriately by each subclass to return a array-style table of
-- strings to be concatenated, separated by commas.

function Movable:display()
  return { " ERROR: abstract method Movable:display() called " }
end

-- Concrete "template" method "toString" converts object to a string
-- representation of form ObjectType( body ).  It calls down to "hook"
-- method "display" from the subclass to convert the "body" of the
-- expression to a string.

function Movable:toString()
  return tostring(self:getTag()) .. 
         "("  ..  table.concat(self:display(), ", ")  ..  ")" 
end

-- Movable mutators (most are deferred, rotate180 has default body)
function Movable:move(v)
  error("Error: Call of move for abstract class " .. 
        self:getTag(), 2)
end

function Movable:reflectX()
  error("Error: Call of reflectX for abstract class " .. 
        self:getTag(), 2)
end

function Movable:reflectY() 
  error("Error: Call of reflectY for abstract class " .. 
        self:getTag(), 2)
end

function Movable:rotate180()
  return (self:reflectX()):reflectY()
end


--[[ CONCRETE SUBCLASS Point prototype (subclass of Movable)

A Point object represents a single point on the Cartesian plane with
the given x and y coordinates. 

The Haskell definition for the Point algebraic data type is as
follows:

     data Point = Point Float Float
                  deriving Show

The Haskell instance declaration for making Point a subclass of
Movable is as follows:

    instance Movable Point where
      move (Vec v1 v2) (Point c1 c2) = Point (c1+v1) (c2+v2)
      reflectX (Point c1 c2)  = Point c1 (-c2)
      reflectY (Point c1 c2)  = Point (-c1) c2
      rotate180 (Point c1 c2) = Point (-c1) (-c2)

Constructor Point:new and the accessor and mutator methods are
inherited from superclass Movable unless overridden below.

--]]

local Point = makeClass(POINT,Movable)

-- Point factory (constructor/initializer) function
function Point:make(xc,yc)
  assert(type(xc) == "number" and type(yc) == "number",
         "Point objects must have numeric x and y coordinates.")
  local o = { x = xc, y = yc }
  return Point:new(o)
end

-- Accessors
function Point:getX()  return self.x  end
function Point:getY()  return self.y  end

function Point:equals(p)
  return isInstanceOf(p,POINT) and 
         self:getX() == p:getX() and self:getY() == p:getY()
end

function Point:lt(p)
  if not isInstanceOf(p,POINT) then
    return false
  else 
    local x1, x2 = self:getX(), p:getX()
    local y1, y2 = self:getY(), p:getY()
    return x1 < x2 or (x1 == x2 and y1 < y2)
  end
end

-- Define the methods deferred from Movable

function Point:display()
  return { tostring(self:getX()), tostring(self:getY()) }
end

function Point:move(v)
  assert(isInstanceOf(v,VECTOR),"Argument to move must be a Vector.")
  return Point:make(self:getX()+v:getX(), self:getY()+v:getY())
end

function Point:reflectX()
  return Point:make(self:getX(), -self:getY()) 
end

function Point:reflectY()
  return Point:make(-self:getX(), self:getY()) 
end

-- Override and redefine "rotate180" efficiently for Points
function Point:rotate180()
  return Point:make(-self:getX(), -self:getY())
end


--[[ ABSTRACT SUBCLASS Figure prototype (subclass of Movable)

A Figure object represents a geometric figure on the Cartesian plane.

The Haskell definition of the Figure algebraic data type is as
follows:

     data Figure = Line Point Point |
                   Circle Point Float
                   deriving Show

The Haskell instance declarations for making Figure a subclass of
Movable is as follows:

    instance Movable Figure where
      move v (Line p1 p2) = Line (move v p1) (move v p2)
      move v (Circle p r) = Circle (move v p) r

      reflectX (Line p1 p2) = Line (reflectX p1) (reflectX p2)
      reflectX (Circle p r) = Circle (reflectX p) r

      reflectY (Line p1 p2) = Line (reflectY p1) (reflectY p2)
      reflectY (Circle p r) = Circle (reflectY p) r

This package defines the Figure class hierarchy with subclasses Line
and Circle for the two Haskell data type constructors used.  Figure is
made a subclass of the abstract class Movable.

Constructor Figure:new and the accessor and mutator methods are
inherited from superclass Movable.

--]]

local Figure = makeClass(FIGURE,Movable)


--[[ CONCRETE SUBCLASS Line prototype (subclass of Figure)

A Line object represents a line passing through the two given distinct
points on the Cartesian plane.  The Haskell code for Line is given
above in the description of Figure.

Constructor Line:new and the accessor and mutator methods are
inherited from superclass Figure unless overridden below.

The Line:make factory method creates a new Line object with a
representation in which point1 < point2.

--]]

local Line = makeClass(LINE,Figure)

-- Line factory (constructor/initializer) function
function Line:make(point1,point2)
  assert(isInstanceOf(point1,POINT) and isInstanceOf(point2,POINT) 
         and not point1:equals(point2),
         "Line:make arguments must be two distinct Points.")
  if point1:lt(point2) then
    o = { p1 = point1, p2 = point2 }
  else 
    o = { p1 = point2, p2 = point1 }
  end
  return Line:new(o)
end

-- Accessors
function Line:getP1()  return self.p1  end
function Line:getP2()  return self.p2  end

-- Define the methods deferred from Figure (and Movable)

function Line:display()
  return { (self:getP1()):toString(), (self:getP2()):toString() }
end

function Line:move(v)
  assert(isInstanceOf(v,VECTOR),
         "Argument to move must be a Vector.")
  return Line:make( (self:getP1()):move(v), 
                    (self:getP2()):move(v) )
end

function Line:reflectX()
  return Line:make( (self:getP1()):reflectX(), 
                    (self:getP2()):reflectX() )
end

function Line:reflectY()
  return Line:make( (self:getP1()):reflectY(), 
                    (self:getP2()):reflectY() )
end


--[[ CONCRETE SUBCLASS Circle prototype (subclass of Figure)

A Circle object represents a circle on the Cartesian plane with the
given center point and radius. The Haskell code for Circle is given
above in the description of Figure.

Constructor Circle:new and the accessor and mutator methods are
inherited from superclass Figure unless overridden below.

--]]

local Circle = makeClass(CIRCLE,Figure)

-- Circle factory (constructor/initializer) function
function Circle:make(cp,r)
  assert(isInstanceOf(cp,POINT) and r >= 0.0,
    "Circle:make arguments are a Point and a nonnegative radius.")
  local o = { center = cp, radius = r }
  return Circle:new(o)
end

-- Accessors
function Circle:getCenter()  return self.center  end
function Circle:getRadius()  return self.radius  end

-- Define the methods deferred from Figure (and Movable)

function Circle:display()
  return { (self:getCenter()):toString(), tostring(self:getRadius()) }
end

function Circle:move(v)
  assert(isInstanceOf(v,VECTOR),
         "Argument to move must be a Vector.")
  return Circle:make( (self:getCenter()):move(v), 
                      self:getRadius()           )
end

function Circle:reflectX()
  return Circle:make( (self:getCenter()):reflectX(), 
                      self:getRadius()              )
end

function Circle:reflectY()
  return Circle:make( (self:getCenter()):reflectY(), 
                      self:getRadius()              )
end


--[[ CONCRETE SUBCLASS MovableList prototype (subclass of Movable)

A MovableList object holds a sequence of Movable objects of any
subclass. 

The Haskell instance declaration for making the builtin Haskell lists
a subclass of Movable is as follows:

    instance Movable a => Movable [a] where
        move v   = map (move v)
        reflectX = map reflectX
        reflectY = map reflectY

A Lua array-style table is the data structure used to implement this
class.

--]]

local MovableList = makeClass(MOVABLELIST,Movable)

-- MovableList factory (constructor/initializer) function
function MovableList:make(l)
  assert(type(l) == "table",
         "MovableList:make argument must be an array-style table.")
  local o = { list = l }
  return MovableList:new(o)
end

-- Accessors
function MovableList:getList()  return self.list  end

-- Define the methods deferred from Movable

function MovableList:display()
  local list = self:getList()
  local res = {}
  for i = 1, #list do
    res[i] = list[i]:toString()
  end
  return res
end

function MovableList:move(v)
  assert(isInstanceOf(v,VECTOR),
         "Argument to move must be a Vector.")
  local list = self:getList()
  local res = {}
  for i = 1, #list do
    res[i] = list[i]:move(v)
  end
  return MovableList:make(res)
end 

function MovableList:reflectX()
  local list = self:getList()
  local res  = {}
  for i = 1, #list do
    res[i] = list[i]:reflectX()
  end
  return MovableList:make(res)
end

function MovableList:reflectY()
  local list = self:getList()
  local res  = {}
  for i = 1, #list do
    res[i] = list[i]:reflectY()
  end
  return MovableList:make(res)
end


--[[ ABSTRACT CLASS Named prototype 

Named objects are objects with associated name strings.

The Haskell class declaration for Named is as follows:

    class Named a where
      lookName :: a -> String
      giveName :: String -> a -> a

--]]

local Named = makeClass(NAMED)

-- Accessors
function Named:getTag()
  return self.tag
end

function Named:lookName()
  error("ERROR: Abstract method Named:lookName called.", 2)
end

-- Deferred "hook" method "display" is used by method "toString" to
-- display the body of the string.  It must be implemented
-- appropriately by each subclass to return a array-style table of
-- strings to be concatenated, separated by commas.

function Named:display()
  return { " ERROR: abstract method Named:display() called " }
end

-- Concrete "template" method "toString" converts object to a string
-- representation of form ObjectType( body ).  It calls down to "hook"
-- method "display" from the subclass to convert the "body" of the
-- expression to a string.

function Named:toString()
  return tostring(self:getTag()) .. 
         "("  ..  table.concat(self:display(), ", ")  ..  ")" 
end

-- Mutators
function Named:giveName(n)
  error("ERROR: Method Named:giveName called.", 2)
end


--[[ CONCRETE CLASS Name prototype (subclass of Named)

The Name class defines a concrete representation for the Named
abstract class.

The Haskell algebraic data type and instance declarations for Name are
as follows:

     data Name = Pair a String
 
     instance Named (Name a) where]
       lookName (Pair obj nm)   = nm
       giveName nm (Pair obj _) = (Pair obj nm)

     mapName :: (a -> b) -> Name a -> Name b
     mapName f (Pair obj nm) = Pair (f obj) nm

The Lua code incorporates mapName into the Name class as a mutator
method that takes the element transformation function as its
explicit parameter.

--]]

local Name = makeClass(NAME,Named)

-- Named factory (constructor/initializer) function
function Name:make(nm,obj)
  assert(type(nm) == "string",
         "First argument of Name:make must be a name string.")
  local o = { name = nm, object = obj }
  return Name:new(o)
end

-- Accessors
function Name:lookName()
  return self.name  
end

function Name:getObject()
  return self.object
end

function Name:display()
  return { self:lookName(), (self:getObject()):toString() }
end

-- Mutators
function Name:giveName(nm)
  assert(type(nm) == "string",
         "Name:giveName argument must be a name string.")
  return Name:make(nm,self:getObject())
end

-- This function is not currently used
function Name:mapName(f)
  return Name:make(self:lookName(),f(self:getObject()))
end


--[[ CONCRETE MULTIPLE INHERITANCE SUBCLASS NamedMovable

MovableNames are Names that are also Movable.

The Haskell class and instance declarations for "movable names" are as
follows:

  instance Movable a => Movable (Name a) where
      move v   = mapName (move v)
      reflectX = mapName reflectX
      reflectY = mapName reflectY

  class (Movable b, Named b) => NamedMovable b

  instance Movable a => NamedMovable (Name a)

Currently, the NamedMovable class and its instance are not
implemented.

The Lua code causes a MovableName object to be created that wraps
the Name object. 

--]]

local MovableName = makeClass(MOVABLENAME,Name,Movable)

-- Factory method for MovableName
function MovableName:make(namedObj)
  assert(type(namedObj) == "table" and isInstanceOf(namedObj,NAME),
         "Argument of MovableName:make must be Name.")
  local obj = namedObj:getObject()
  assert(type(obj) == "table" and isInstanceOf(obj,MOVABLE),
         "MovableName's object must be Movable.")
  return MovableName:new(namedObj)
end

-- Define the methods deferred from Movable

function MovableName:display()
  return Name.display(self) -- use the display() in Name (not Movable)
end

function MovableName:move(v)
  assert(isInstanceOf(v,VECTOR),"Argument to move must be a Vector.")
  local newObj = (self:getObject()):move(v) 
  return MovableName:make(Name:make( self:lookName(), newObj ))
end

function MovableName:reflectX()
  local newObj = (self:getObject()):reflectX() 
  return MovableName:make(Name:make( self:lookName(), newObj ))
end

function MovableName:reflectY()
  local newObj = (self:getObject()):reflectY() 
  return MovableName:make(Name:make( self:lookName(), newObj ))
end


-- Some PRELIMINARY testing code 

-- Function "show_data" converts raw Lua data structures to strings to
-- assist in debugging and testing.  This is borrowed from the Complex
-- Number package.

local function show_data(d)
  if type(d) == "table" then
    local res = {}
    for k,v in pairs(d) do
      res[#res+1] = "[" .. show_data(k) .. "] = " .. show_data(v)
    end
    return "(" .. table.concat(res, ", ") .. ")"
  else
    return tostring(d)
  end
end

-- Display test data
print("\nTest data for Figures")
local disp   = Vector:make(10.0, 10.0)
print("disp              == " .. disp:toString())
print("isInstanceOf(disp,VECTOR) == " .. 
      tostring(isInstanceOf(disp,VECTOR)))

local origin = Point:make(0.0,0.0)
print("origin            == " .. origin:toString())

local unit   = Point:make(1.0,1.0)
print("unit              == " .. unit:toString())

local diag   = Line:make(origin,unit)
print("diag              == " .. diag:toString())

local circ02 = Circle:make(origin,2.0)
print("circ02            == " .. circ02:toString())

local circ12 = Circle:make(unit,2.0)
print("circ12            == " .. circ12:toString())

local list   = {diag,circ12,unit}
print("list              == " .. show_data(list))

local mlist  = MovableList:make(list)

print("mlist             == " .. mlist:toString())

-- Test Point's Movable methods
print("\nTesting Movable methods of Point")
print("disp               == " .. disp:toString())
print("origin             == " .. origin:toString())
print("unit               == " .. unit:toString())
print("origin:move(disp)  == " .. (origin:move(disp)):toString())
print("unit:reflectX()    == " .. (unit:reflectX()):toString())
print("unit:reflectY()    == " .. (unit:reflectY()):toString())
print("unit:rotate180()   == " .. (unit:rotate180()):toString())

-- Test Line's Movable methods
print("\nTesting Movable methods of Line")
print("disp               == " .. disp:toString() )
print("diag               == " .. diag:toString() )
print("diag:move(disp)    == " .. (diag:move(disp)):toString() )
print("diag:reflectX()    == " .. (diag:reflectX()):toString() )
print("diag:reflectY()    == " .. (diag:reflectY()):toString() )
print("diag:rotate180()   == " .. (diag:rotate180()):toString() )

-- Test Circle Movable methods
print("\nTesting Movable methods of Circle")
print("disp               == " .. disp:toString() )
print("circ02             == " .. circ02:toString() )
print("circ12             == " .. circ12:toString() )
print("circ02:move(disp)  == " .. (circ02:move(disp)):toString() )
print("circ12:reflectX()  == " .. (circ12:reflectX():toString()) )
print("circ12:reflectY()  == " .. (circ12:reflectY()):toString() )
print("circ12:rotate180() == " .. (circ12:rotate180()):toString() )

-- Test MovableList Movable methods
print("\nTesting Movable methods of MovableList")
print("disp               == " .. disp:toString())
print("mlist              == " .. mlist:toString())
print("mlist:move(disp)   == " .. (mlist:move(disp)):toString() )
print("diag:reflectX()    == " .. (diag:reflectX()):toString() )
print("diag:reflectY()    == " .. (diag:reflectY()):toString() )
print("diag:rotate180()   == " .. (diag:rotate180()):toString() )
print("mlist:reflectX()   == " .. (mlist:reflectX()):toString() )
print("mlist:reflectY()   == " .. (mlist:reflectY()):toString() )
print("mlist:rotate180()  == " .. (mlist:rotate180()):toString() )

-- Test Name's Named methods
print("\nTesting Named methods of Name")
local aa = Name:make("AA",unit)
print("aa                 == " .. aa:toString() )
print("aa:lookName()      == " .. aa:lookName() )
local bb = aa:giveName("BB")
print("aa:giveName(\"BB\")  == " .. bb:toString() )

--Test Movable methods of MovableName
print("\nTesting Movable methods of MovableName")
print("disp               == " .. disp:toString())
local mn = MovableName:make(Name:make("zzz",unit))
print("mn                 == " .. mn:toString())
print("mn:move(disp)      == " .. (mn:move(disp)):toString() )
print("mn:reflectX()      == " .. (mn:reflectX()):toString() )
print("mn:reflectY()      == " .. (mn:reflectY()):toString() )
print("mn:rotate180()     == " .. (mn:rotate180()):toString() )

--  Test Named methods of MovableName using conversions
print("\nTesting Named methods of MovableName")
print("aa                 == " .. aa:toString() )
print("mn                 == " .. mn:toString() )
print("mn:lookName()      == " .. (mn:lookName()) )
local newname = mn:giveName("BB")
print("mn:giveName(\"BB\")   == " .. (mn:giveName("BB")):toString())
print("newname above      == " .. newname:toString() )