{- CSci 450/503: Org. of Programming Languages, NamedMovable Module
   Movable Objects Case Study from Thompson textbook
   H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

2017-10-28: Adapt original from Thompson Sec. 4.6
2017-10-31: Factor original into 3 modules, including this one

Adapted from Chapter 14, Section 6, of:
    Simon Thompson.
    Haskell: The Craft of Functional Programming, Third Edition
    Addison-Wesley, 1996-2011.

Class laws for NamedObjects?
-   NamedMovable type must satisfy Movable and Named class laws

Points of interest in code:

*1* Reexport imported features
*2* Import listed features, classes with *methods, types with
    constructors
*3* Function **lifts** function to work over named objects
*4* All operations on the Movable class can be **lifted**
*5* Type class NamedMovable combines Named & Movable
*6* Type class NamedMovable thus reuses all code for both
    Named and Movable classes

-}

module NamedMovableObjects
  ( -- *1* from MovableObjects module 
    Movable(..)      -- export class and all methods
  , Point(..)        -- export data type and all constructors
  , Figure(..)
  , Vector(..)
   -- *1* from NamedObjects module
  , Named(..)        -- export class and all methods
  , Name(..)         -- export data type and all constructors
   -- from this module
  , NamedMovable(..) -- export class and all methods
  , mapName          -- export function
  )
where

{- NAMED MOVABLE OBJECTS -}

import MovableObjects  -- *2* import list
    ( Movable(..), Vector(..), Point(..), Figure(..) )
import NamedObjects    -- *2* import list
    ( Named(..), Name(..) )

-- *3* Function "mapName" **lifts** a function to work over
-- "named" objects
mapName :: (a -> b) -> Name a -> Name b
mapName f (Pair nm obj) = Pair nm (f obj) 


-- *4* All operations on the Movable class can be **lifted**
-- Can make Name an instance of Movable if its wrapped object is
instance Movable a => Movable (Name a) where
    move v   = mapName (move v)
    reflectX = mapName reflectX
    reflectY = mapName reflectY
    -- reflect180 uses default

-- *5* Type class NamedMovable combines Named & Movable
class (Movable b, Named b) => NamedMovable b

-- *6* Type class NamedMovable thus reuses all code for both
-- Named and Movable classes
instance Movable a => NamedMovable (Name a)