module skeleton5

import iTasks
import Data.Functor

/*
 * Pieter Koopman, pieter@cs.ru.nl
 * Advanced Programming. Skeleton for assignment 5
 *  - use this a project with environment iTasks
 *  - executable must be in Examples/iTasks or a subdirectory
 * You can also use the -sdk commandline flag to set the path
 * check Project Options -> Profiling -> Dynamics to prevent recompilation
 */

:: Student =
	{ name :: String
	, snum :: Int
	, bama :: BaMa
	, year :: Int
	}

:: BaMa = Bachelor | Master

derive class iTask Student, BaMa

//Start w = startEngine (task8 (hd students)) w
Start w = startEngine (chooseTask >>= id) w

chooseTask :: Task (Task ())
chooseTask = snd <$> enterChoice (Title "What do you want to see?")
	[ChooseFromDropdown fst]
	[ ("Enter a new student",             () <$ task1)
	, ("Enter a list of students",        () <$ task2)
	, ("Update the first student",        () <$ task3 (hd students))
	, ("Pick a favourite student",        () <$ task4)
	, ("Pick a student (name only)",      () <$ task5)
	, ("Pick a student (gToString)",      () <$ task6)
	, ("Pick partners",                   () <$ task7)
	, ("Change the first student's name", () <$ task8 (hd students))
	]

task1 :: Task Student
task1 = enterInformation (Title "Enter a student") []

task2 :: Task [Student]
task2 = enterInformation (Title "Enter some students") []

task3 :: (Student -> Task Student)
task3 = updateInformation (Title "Update the student") []

task4 :: Task Student
task4 = enterChoice (Title "Pick a student") [] students

task5 :: Task Student
task5 = enterChoice (Title "Pick a student") [ChooseFromDropdown \s -> s.Student.name] students

task6 :: Task Student
task6 = enterChoice (Title "Pick a student") [ChooseFromDropdown gToString{|*|}] students

task7 :: Task [Student]
task7 = enterMultipleChoice (Title "Pick some partners") [ChooseFromCheckGroup show] students
where show s = s.Student.name + " (" + gToString{|*|} s.bama + ")"

// I suppose there is a nicer way for this, perhaps using withEditMode?
// But then how to select the fields for which the View mode applies?
task8 :: Student -> Task Student
task8 s = updateInformation
	(Title "Update the student")
	[UpdateAs (\s -> s.Student.name) (\s n -> {Student | s & name=n})]
	s -|| viewInformation (Title "Current value") [] s

students :: [Student]
students =
	[ { name = "Alice"
	  , snum = 1000
	  , bama = Master
	  , year = 1
	  }
	, { name = "Bob"
	  , snum = 1003
	  , bama = Master
	  , year = 1
	  }
	, { name = "Carol"
	  , snum = 1024
	  , bama = Master
	  , year = 2
	  }
	, { name = "Dave"
	  , snum = 2048
	  , bama = Master
	  , year = 1
	  }
	, { name = "Eve"
	  , snum = 4096
	  , bama = Master
	  , year = 1
	  }
	, { name = "Frank"
	  , snum = 1023
	  , bama = Master
	  , year = 1
	  }
	]

generic gToString a :: a -> String
gToString{|Int|} x = toString x
gToString{|String|} x = x
gToString{|UNIT|} UNIT = ""
gToString{|PAIR|} fx fy (PAIR x y) = fx x + " " + fy y
gToString{|EITHER|} fx fy (LEFT x) = fx x
gToString{|EITHER|} fx fy (RIGHT y) = fy y
gToString{|CONS of d|} fx (CONS x)
| d.gcd_arity == 0 = d.gcd_name
| otherwise        = d.gcd_name + " " + fx x
gToString{|OBJECT|} fx (OBJECT x) = fx x
gToString{|FIELD of f|} fx (FIELD x) = f.gfd_name + ": " + fx x + next
where
	next
	| f.gfd_index == f.gfd_cons.grd_arity - 1 = ""
	| otherwise = "; "
gToString{|RECORD|} fx (RECORD x) = fx x

derive gToString Student, BaMa

instance + String where + s t = s +++ t