cursors.hs

{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}


import Data.Map (Map, unionWith) 

class Box b a where
	insert :: a -> b -> b
	delete :: a -> b -> b

slide :: Box b a => a -> a -> b -> b
slide x y = insert y . delete x

class Cursor b a where
	left :: b a -> b a
	right :: b a -> b a
	point :: b a -> a

data Zipper a =  Z [a] a [a]
mkZ :: [a] -> Zipper a
mkZ (x:xs) = Z  [] x xs

instance Cursor Zipper a where
	left z@(Z [] _ _) = z
	left (Z (x:xs) y zs) = Z xs x (y:zs)
	right z@(Z _ _ []) = z
	right (Z xs y (z:zs)) = Z (y:xs) z zs
	point (Z _ x _) = x

data Stat a b = S (Zipper a) b (Zipper a)

mkS :: Box b a => [a] -> Int -> b -> Stat a b
mkS xs n y = (!!n) . iterate openR $ S (mkZ xs) y (mkZ xs) 

openR (S xs y zs) =  S xs (insert (point zs) y) (right zs) 
openL (S xs y zs) =  S (left xs) (insert (point xs) y) zs 
closeL (S xs y zs) =  S (right xs) (delete (point xs) y) zs 
closeR (S xs y zs) =  S xs (delete (point zs) y) (left zs) 

instance Box b a => Cursor (Stat a) b where
	left (S xs y zs) = S (left xs) (slide (point zs) (point xs) y) (left zs) 
	right (S xs y zs) = S (right xs) (slide (point xs) (point zs) y) (right zs) 
	point (S xs y zs) = y 

instance Box Int Int where
	insert = (+)
	delete = subtract


type Param = Map String Double

type Revol = Map Integer Param

instance Box Param Param where
	insert = unionWith (+)
	delete = unionWith (-)

instance Box Revol Revol where
	insert = unionWith insert
	delete = unionWith delete

{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}

import Data.Map (Map, unionWith)

class Box b a where
insert :: a -> b -> b
delete :: a -> b -> b

slide :: Box b a => a -> a -> b -> b
slide x y = insert y . delete x

class Cursor b a where
left :: b a -> b a
right :: b a -> b a
point :: b a -> a

data Zipper a = Z [a] a [a]
mkZ :: [a] -> Zipper a
mkZ (x:xs) = Z [] x xs

instance Cursor Zipper a where
left z@(Z [] _ _) = z
left (Z (x:xs) y zs) = Z xs x (y:zs)
right z@(Z _ _ []) = z
right (Z xs y (z:zs)) = Z (y:xs) z zs
point (Z _ x _) = x

data Stat a b = S (Zipper a) b (Zipper a)

mkS :: Box b a => [a] -> Int -> b -> Stat a b
mkS xs n y = (!!n) . iterate openR $ S (mkZ xs) y (mkZ xs)

openR (S xs y zs) = S xs (insert (point zs) y) (right zs)
openL (S xs y zs) = S (left xs) (insert (point xs) y) zs
closeL (S xs y zs) = S (right xs) (delete (point xs) y) zs
closeR (S xs y zs) = S xs (delete (point zs) y) (left zs)

instance Box b a => Cursor (Stat a) b where
left (S xs y zs) = S (left xs) (slide (point zs) (point xs) y) (left zs)
right (S xs y zs) = S (right xs) (slide (point xs) (point zs) y) (right zs)
point (S xs y zs) = y

instance Box Int Int where
insert = (+)
delete = subtract

type Param = Map String Double

type Revol = Map Integer Param

instance Box Param Param where
insert = unionWith (+)
delete = unionWith (-)

instance Box Revol Revol where
insert = unionWith insert
delete = unionWith delete