Cacher is the code snippet organizer for pro developers

module Main where

import Data.Ix

data Cell = Cell
	{
		position :: (Integer, Integer, Integer),
		value :: String
	}

instance Show Cell where
	show (Cell (s, x, y) value) = "(" ++ show s ++  ": " ++ show x ++  ", " ++ show y ++ ", " ++ show value ++ ")"

copyCells cells src@(s, x1, y1, x2, y2) (s', x, y) = cellsNotInDst ++ cellsTranslated where
	cellsNotInDst = [c | c <- cells, not $ inRegion toRect $ position c]
	cellsTranslated = [translate c | c <- cells, inRegion src $ position c]
	translate (Cell (_, cx, cy) val) = Cell (s', cx + x - x1, cy + y - y1) val
	toRect = (s', x, y, x + x2 - x1, y + y2 - y1)
	inRegion (s, x1, y1, x2, y2) (s', cx, cy) = s == s' && inRange (x1, x2) cx && inRange (y1, y2) cy

loop cells backhist fwdhist = do
	command <- getLine
	case words command of
		["setval", s, x, y, val] -> loop (Cell pos val : [c | c <- cells, position c /= pos]) newbackhist [] where
			pos = (read s, read x, read y)
		["copy", s, x1, y1, x2, y2, s', x, y] -> loop (copyCells cells (read s, read x1, read y1, read x2, read y2) (read s', read x, read y)) newbackhist []
		["clear", s, x, y] -> loop [c | c <- cells, position c /= (read s, read x, read y)] newbackhist []
		["show"] -> print cells >> loop cells backhist fwdhist
		["undo"] -> if length backhist == 0
				then putStrLn "Undo buffer empty" >> loop cells backhist fwdhist
				else loop (head backhist) (tail backhist) (cells : fwdhist)
		["redo"] -> if length fwdhist == 0
				then putStrLn "Redo buffer empty" >> loop cells backhist fwdhist
				else loop (head fwdhist) newbackhist (tail fwdhist)
		["quit"] -> return ()
		_ -> putStrLn "Commands: setval s x y v; copy s x1 y2 x2 y2 s' x y; clear s x y; show; undo; redo; quit" >> loop cells backhist fwdhist
	where newbackhist = cells : backhist

main = loop [] [] []