-- OPTIONS -fglasgow-exts -fth -fallow-undecidable-instances 
{-# LANGUAGE TemplateHaskell, UndecidableInstances, ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) The University of Pennsylvania, 2006
-- License     :  BSD
-- 
-- Maintainer  :  sweirich@cis.upenn.edu
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A file demonstrating the use of RepLib
--
-----------------------------------------------------------------------------

module Main where

import Data.RepLib
import Language.Haskell.TH


-- For each datatype that we define, we need to also create its representation. 
-- The template Haskell function derive does this automatically for 
-- each type.

data Tree a = Leaf a | Node (Tree a) (Tree a)
$(derive [''Tree])

data Day = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
$(derive [''Day])

-- Note, for mutually recursive datatypes, use "derive" and give list
-- of type names.

-- Note also that the functions of RepLib can cooperate with the 
-- traditional 'deriving' mechanism
data Company   = C [Dept]                 deriving (Eq, Ord, Show)         
data Dept      = D String Manager [CUnit] deriving (Eq, Ord, Show)         
data Manager   = M Employee               deriving (Eq, Ord, Show)         
data CUnit     = PU Employee | DU Dept    deriving (Eq, Ord, Show)        
data Employee  = E Person Salary          deriving (Eq, Ord, Show)         
data Person    = P String                 deriving (Eq, Ord, Show)         
data Salary    = S Float                  deriving (Eq, Ord, Show)         

$(derive 
    [''Company, 
     ''Dept, 
     ''CUnit, 
     ''Employee, 
 	  ''Manager, 
 	  ''Person, 
 	  ''Salary])


-- 
-- Some sample data for these types
-- 
t1 :: Tree Int 
t1 = Node (Node (Leaf 3) (Leaf 4)) (Node (Leaf 5) (Leaf 6))

t2 :: Tree Int 
t2 = Node (Node (Leaf 0) (Leaf 7)) (Leaf 20)

s1 :: Company
s1 = C [D "Types" (M (E (P "Stephanie") (S 1000.0))) 
            [PU (E (P "Michael") (S 50)), 
             PU (E (P "Samuel") (S 50)),
             PU (E (P "Theodore") (S 50))],
        D "Terms" (M (E (P "Stephanie") (S 200)))
            [DU (D "Shipping" (M (E (P "Alice") (S 3000)))
                [])]]
                 

--
-- Prelude operations.
--
-- Note that we didn't derive Eq, Ord, Bounded or Show for "Day" and "Tree". We can 
-- do that now with operations from RepLib.PreludeLib.

-- for Day
instance Eq Day      where 
  (==) = eqR1 rep1
instance Ord Day     where 
  compare = compareR1 rep1
instance Bounded Day where 
  minBound = minBoundR1 rep1 
  maxBound = maxBoundR1 rep1
instance Show Day    where 
  showsPrec = showsPrecR1 rep1

-- for Tree
instance (Rep a, Eq a) => Eq (Tree a)     where (==) = eqR1 rep1
instance (Rep a, Show a) => Show (Tree a) where showsPrec = showsPrecR1 rep1
instance (Rep a, Ord a) => Ord (Tree a)   where compare = compareR1 rep1

-- Besides the prelude operations, RepLib provides a number of other 
-- type-indexed operations.

--
-- Instances for RepLib.Lib operations
--

-- Generate creates arbitrary elements of a type, up to a certain depth.
instance Generate Day
instance Generate a => Generate (Tree a)
instance Generate Company
instance Generate Dept
instance Generate Manager
instance Generate CUnit
instance Generate Employee
instance Generate Person
instance Generate Salary					  
	 

-- Sum adds together all of the Ints in a datastructure
instance GSum a => GSum (Tree a)
instance GSum Company
instance GSum Dept
instance GSum Manager
instance GSum CUnit
instance GSum Employee
instance GSum Person
instance GSum Salary

-- Shrink creates smaller versions of a data structure.
instance Shrink a => Shrink (Tree a)

-- 
-- SYB Style operations
-- 
-- RepLib also supports many of the combinators from the SYB library. For example, 
-- we can include the following code from the "Paradise" benchmark that gives everyone 
-- in the company a raise.

-- Increase salary by percentage
increase :: Float -> Company -> Company
increase k = everywhere (mkT (incS k))

-- "interesting" code for increase
incS :: Float -> Salary -> Salary
incS k (S s) = S (s * (1+k))


--
-- Generalized folds
--
-- finally, we define generalized versions of fold left and 
-- fold right for the Tree type constructor.
instance Fold Tree where
  foldRight op = rreduceR1 (rTree1 (RreduceD { rreduceD = op })
                                   (RreduceD { rreduceD = foldRight op}))
  foldLeft  op = lreduceR1 (rTree1 (LreduceD { lreduceD = op })
                                   (LreduceD { lreduceD = foldLeft op }))

main = do print (minBound :: Day)
          print (maxBound :: Day)
          print t1
          print s1
          print (Monday < Tuesday)
          print (t1 < t2)
--          
          print (generate 7 :: [Day])
          print (generate 3 :: [Tree Int])
          print (generate 7 :: [Company])
--
          print (subtrees t1)
          print (gsum t1)
          print (gsum t2)
--
          print (increase 0.1 s1)
          print (s1 < (increase 0.2 s1))
-- 
          print (gproduct t1)
          print (count t1)