-- | An Editor backend implementation, made of the instance of Engine of InsideAppend.
module Buffer (InsideAppend (..))
where

import Data.Maybe
import Engine
import Test.QuickCheck

-- |See the "Engine" class docs 
data InsideAppend 
	-- | the cursor when its pointing to a real line (eg line function doesn't fail)
	= Inside {
		left 	:: [String], 	-- ^ lines before the cursor (reversed order)
		cursor 	::String , 	-- ^ addressed line
		right 	:: [String]	-- ^ lines after the cursor
		}
	-- | the cursor is pointing either to insert at the front of the file or  
	-- append at the end of the file.
	| Append  
		{ 
		elems :: Either [String] [String] -- ^ Left lines is in append mode, Right is in insert at front mode.
		}
	deriving (Show , Eq)

instance Engine InsideAppend where
	listIn xs 			= Append (Right xs)
	prev (Append (Right _ )) 	= Nothing 
	prev (Append (Left [] )) 	= error "empty Append Left"
	prev (Append (Left (l:ls))) 	= Just $ Inside ls l [] 
	prev (Inside [] x ls) 		= Just $ Append (Right (x:ls)) 
	prev (Inside (l:ls) x rs) 	= Just $ Inside ls l (x:rs) 
	next (Append (Right [] )) 	= Nothing
	next (Append (Right (r:rs))) 	= Just $ Inside [] r rs 
	next (Append (Left [] )) 	= error "empty Append Left"
	next (Append (Left _ )) 	= Nothing
	next (Inside ls x [] ) 		= Just $ Append (Left (x:ls)) 
	next (Inside ls x (r:rs)) 	= Just $ Inside (x:ls) r rs 
	end w@ (Append (Left _)) 	= Just w
	end w 				= next w >>= end
	start w@ (Append (Right _)) 	= Just w
	start w 			= prev w >>= start 
	pos (Append (Left ls)) 		= End (length ls + 1)
	pos (Append (Right _)) 		= Begin
	pos (Inside ls _ _) 		= Line $ length ls + 1
	del (Append _) 			= Nothing
	del (Inside [] _ [] ) 		= Just $ Append (Right []) 
	del (Inside ls _ [] ) 		= Just $ Append (Left ls) 
	del (Inside ls _ (r:rs)) 	= Just $ Inside ls r rs
	deln n w 	| n == 0 	= Just w
		 	| True 		= del w >>= deln (n-1)
	add xs (Append (Left _ )) 	= Nothing
	add xs (Append (Right rs)) 	= Just $ Append $ Right (xs ++ rs)
	add xs (Inside ls x rs) 	= Just $ Inside ls x (xs ++ rs) 
	ins xs w 			= prev w >>= add xs >>= next 
	jump n w 			= start w >>= rjump n 
	listOut w 			= start w >>= \(Append (Right rs)) -> return rs
	linen 0 _ 			= Just []
	linen _ (Append _) 		= Nothing
	linen n w@ (Inside _ x _ ) 	= next w >>= linen (n - 1) >>= Just . (x:)
	
	tillend w 			= filter isInside (runner next w)

	fromstart w			= reverse $ filter isInside (runner prev w)

	fwdcycle w			= filter isInside $ runner next w ++ reverse (runner prev w) ++ [w]
	bwdcycle w			= filter isInside $ runner prev w ++ reverse (runner next w) ++ [w] 

isInside	:: InsideAppend -> Bool
isInside (Inside _ _ _) = True
isInside _		= False

runner 	:: Change InsideAppend -> InsideAppend -> [InsideAppend]
runner op w = maybe [] (\w -> (w : runner op w)) (op w)

prop_E1_IA = prop_E1 :: (W InsideAppend) -> String -> Bool 
--prop_Empty_IA = prop_Empty :: 
t = listIn ["paolo","va","in","bici"] :: InsideAppend