module compare


//	**************************************************************************************************
//
//	A program in which two text files can be compared char by char.
//
//	The program has been written in Clean 1.3.1 and uses the Clean Standard Object I/O library 1.0.1
//	
//	**************************************************************************************************


import StdEnv, StdIO


::	Local
	=	{	name1	:: String
		,	name2	:: String
		}

noFilesSelected
	=	{ name1="", name2="" }


Start :: *World -> *World
Start world
	=	startIO noFilesSelected 0 [initIO] [] world

initIO :: (PSt Local .p) -> PSt Local .p
initIO ps
	#	(showid,ps)	= accPIO openId ps
	#	(_,ps)		= openMenu undef (file showid) ps
	=	ps
where
	file showid
		=	Menu "File"
				(	MenuItem "Compare..."		[MenuFunction (noLS compare),		MenuShortKey 'c']
				:+:	MenuItem "Compare again"	[MenuFunction (noLS again),			MenuShortKey 'a']
				:+:	MenuSeparator				[]
				:+:	MenuItem "Quit"				[MenuFunction (noLS closeProcess),	MenuShortKey 'q']
				)	[]
	where
		compare :: (PSt Local .p) -> PSt Local .p
		compare ps
			#	(maybeFirstFile,ps)			= selectInputFile ps
			|	isNothing maybeFirstFile
				=	{ps & ls=noFilesSelected}
			#	(maybeSecondFile,ps)		= selectInputFile ps
			|	isNothing maybeSecondFile
				=	{ps & ls=noFilesSelected}
			|	otherwise
				#	ps	= {ps & ls={name1=fromJust maybeFirstFile,name2=fromJust maybeSecondFile}}
				=	showdifference ps
		
		again :: (PSt Local .p) -> PSt Local .p
		again ps=:{ls={name1,name2}}
			|	name1=="" || name2==""
				=	compare ps
			|	otherwise
				=	showdifference ps
		
		showdifference :: (PSt Local .p) -> PSt Local .p
		showdifference ps=:{ls={name1,name2}}
			#	ps						= closeWindow showid ps
			#	(files,ps)				= accFiles (openfilepair (name1,name2)) ps
				(maybeDifference,files)	= comparefilepair 1 files
			#	ps						= appFiles (closefilepair files) ps
			|	isNothing maybeDifference
				=	appPIO beep ps
			#	(error,ps)				= openDialog undef (dialog (fromJust maybeDifference)) ps
			|	error<>NoError
				=	abort "Could not open dialog."
			|	otherwise
				=	ps
		where
			dialog (i,line1,line2)		= Dialog "Difference found"
											(	ListLS
											[	TextControl ("Difference at line "+++toString i) []
											,	TextControl line1 [ControlPos (Left,zero)]
											,	TextControl line2 [ControlPos (Left,zero)]
											])
											[	WindowId	showid
											,	WindowClose	(noLS (closeWindow showid))
											]

openfilepair :: (String,String) *Files -> ((*File,*File), *Files)
openfilepair (fname1,fname2) files
	#	(ok,f1,files)	= fopen fname1 FReadText files
	|	not ok
		=	abort ("Could not open "+++fname1)
	#	(ok,f2,files)	= fopen fname2 FReadText files
	|	not ok
		=	abort ("Could not open "+++fname2)
	|	otherwise
		=	((f1,f2),files)

closefilepair :: (*File,*File) *Files -> *Files
closefilepair (f1,f2) files
	#	(ok,files)	= fclose f1 files
	|	not ok
		=	abort "Could not close first file."
	#	(ok,files)	= fclose f2 files
	|	not ok
		=	abort "Could not close second file."
	|	otherwise
		=	files

comparefilepair :: Int (*File,*File) -> (Maybe (Int,String,String), (*File,*File))
comparefilepair i (f1,f2)
	|	sfend f1 && sfend f2
		=	(Nothing,(f1,f2))
	#	(line1,f1)	= freadline f1
	#	(line2,f2)	= freadline f2
	|	line1<>line2
		=	(Just (i,line1,line2),(f1,f2))
	|	otherwise
		=	comparefilepair (i+1) (f1,f2)