sai-shape-syb-0.2.0: tests/test-03.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}

  module Main ( main ) where

  import SAI.Data.Generics.Shape.SYB ( Homo, ghom, shapeOf, weightedShapeOf )
--import SAI.Data.Generics.Shape.SYB ( Rose(..) )
  import SAI.Data.Generics.Shape.SYB ( showAsParens )
  import Data.Data ( Data, Typeable )
--import Data.Data
  import Data.Generics.Aliases ( extQ )
--import Data.Generics.Aliases ( mkT )
--import Data.Generics.Schemes ( everywhere )
--import Data.Generics ( Generic )
--import Data.Tree ( Tree(..) )

  data CompanyType = Company [DepartmentType]
  data DepartmentType = Department String ManagerType [EmployeeType]
  data ManagerType = Manager { rank :: Float
                             , manName :: String
                             , manSalary :: SalaryType }
  data EmployeeType = Employee { empName :: String
                               , empSalary :: SalaryType }
  data SalaryType = Salary Float
  deriving instance Data CompanyType
  deriving instance Data DepartmentType
  deriving instance Data ManagerType
  deriving instance Data EmployeeType
  deriving instance Data SalaryType
  deriving instance Typeable CompanyType
  deriving instance Typeable DepartmentType
  deriving instance Typeable ManagerType
  deriving instance Typeable EmployeeType
  deriving instance Typeable SalaryType

  data NiceRecord = NiceRecord { nice_name :: String
                               , nice_salary :: Int }
    deriving ( Show )
  dud_record = NiceRecord "" 0

------------------------------

  -- small, one department retail company
  company1 = Company [Department "Sales" (Manager 1 "Deborah" (Salary 75000)) [Employee "Jane" (Salary 35000)]]

  main = putStrLn $ showAsParens $ shapeOf company1
--main = putStrLn $ show $ shapeOf company1
--main = putStrLn $ show $ test1 company1
--main = putStrLn $ show $ test2 company1

  test1 :: CompanyType -> Homo ()
--test1 :: forall d. Data d => d -> Homo ()
  test1 = ghom (\_ _->()) (const ())

#if 0
--test2 :: EmployeeType -> Homo NiceRecord
--test2 :: forall d. Data d => d -> Homo NiceRecord
  test2 = ghom k (const dud_record `extQ` f_EmployeeType `extQ` f_ManagerType)
--test2 = ghom k f
   where
    f_EmployeeType (Employee name (Salary salary))
      = NiceRecord name (floor salary)
    f_ManagerType (Manager _ name _)
      = NiceRecord name 0
    k r _ = r
#endif