-- | A zipped list with special cursor at the ends. In fact it handles inserting at start and appending at end where the cursor is pointing to non existing lines.
module Engine where

import Test.QuickCheck
import Control.Monad
import Data.Maybe
import Data.List

-- | represent an action, which can fail with Nothing , an index error
type Change a = a -> Maybe a

-- | Pos represent the position addressed in the engine
data Pos 
	-- | the engine addresses a real line 
	= Line { 
	nth :: Int -- ^ The index of the line starting from 1 
	}
	-- | the engine addresses before first line , if ever present
	| Begin 	
	-- | the engine addresses after last line
	| End {
	lns :: Int -- ^ The number of lines in the engine
	}
	deriving Show
-- | relative distance between two positions
distance (Line n) (Line m) 	= m - n +1
distance Begin    (Line m)	= m
distance (Line n) (End m) 	= m - n
distance Begin    (End m)	= m
distance _ _ 			= 0	 


data Engine 
	-- | 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.
	| Corner  
		{ 
		elems :: Either [String] [String] -- ^ Left lines is in append mode, Right is in insert at front mode.
		}
	deriving (Show , Eq)
-- | An empty engine
empty 		:: Engine 			
empty 		= listIn []
-- | An engine is isomorphic to Engine list
listIn		:: [String] -> Engine 	
-- | Extract the list from the engine
listOut 	:: Engine -> Maybe [String] 	
-- | Extract n lines from the position addressed
linen		:: Int -> Engine -> Maybe [String]	 
-- | Extract the addressed line
line 		:: Engine -> Maybe String	
line w 		= head `fmap` linen 1 w
-- | Possibly set the addressed line to the nth line
jump 		:: Int -> Change Engine	
-- | Insert some lines before the addressed line
ins		:: [String] -> Change Engine	
-- | Insert some lines after the addressed line
add		:: [String] -> Change Engine 
-- | Delete the addressed line , address the next one
del 		:: Change Engine		
-- | Delete n lines from the addressed position
deln 		:: Int -> Change Engine	
-- | Address an append position
end 		:: Change Engine 	
-- | Address before the first line
start		:: Change Engine	
-- | The number of the addressed line
pos		:: Engine -> Pos	
-- | Address the next line
next		:: Change Engine	
-- | Address the prev line
prev 		:: Change Engine 	
-- | Jump back n lines 
prevn 		:: Int -> Change Engine	
prevn 0 w	= Just w		
prevn n w 	= prev w >>= prevn (n-1) 
-- | Jump ahead n lines
nextn 		:: Int -> Change Engine	
nextn 0 w	= Just w
nextn n w 	= next w >>= nextn (n-1) 
-- | Jump n lines relative to the addredded line
rjump		:: Int -> Change Engine	
rjump n		= iterateM n (if n > 0 then next else prev) where
	iterateM n f w 	| n > 0 = f w >>= iterateM (n - 1) f
			| True = Just w
-- | Create all the engines from the addressed one to the last one 
tillend		:: Engine -> [Engine]
-- | all the next engines from the addressed next to itself , wrapping around
fwdcycle 	:: Engine -> [Engine]
-- | Create all the engines from the start to the addressed one included
fromstart	:: Engine -> [Engine]
-- | all the prev engines from the addressed prev to itself , wrapping around
bwdcycle	:: Engine -> [Engine]

-- | last element if present
last 	::	Change Engine
last t = end t >>= prev
-- | first element if present
first 	::  Change Engine
first t = start t >>= next


listIn xs 			= Corner (Right xs)
prev (Corner (Right _ )) 	= Nothing 
prev (Corner (Left [] )) 	= error "empty Corner Left"
prev (Corner (Left (l:ls))) 	= Just $ Inside ls l [] 
prev (Inside [] x ls) 		= Just $ Corner (Right (x:ls)) 
prev (Inside (l:ls) x rs) 	= Just $ Inside ls l (x:rs) 
next (Corner (Right [] )) 	= Nothing
next (Corner (Right (r:rs))) 	= Just $ Inside [] r rs 
next (Corner (Left [] )) 	= error "empty Corner Left"
next (Corner (Left _ )) 	= Nothing
next (Inside ls x [] ) 		= Just $ Corner (Left (x:ls)) 
next (Inside ls x (r:rs)) 	= Just $ Inside (x:ls) r rs 
end w@ (Corner (Left _)) 	= Just w
end w 				= next w >>= end
start w@ (Corner (Right _)) 	= Just w
start w 			= prev w >>= start 
pos (Corner (Left ls)) 		= End (length ls + 1)
pos (Corner (Right _)) 		= Begin
pos (Inside ls _ _) 		= Line $ length ls + 1
del (Corner _) 			= Nothing
del (Inside [] _ [] ) 		= Just $ Corner (Right []) 
del (Inside ls _ [] ) 		= Just $ Corner (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 (Corner (Left _ )) 	= Nothing
add xs (Corner (Right rs)) 	= Just $ Corner $ 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 >>= \(Corner (Right rs)) -> return rs
linen 0 _ 			= Just []
linen _ (Corner _) 		= 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	:: Engine -> Bool
isInside (Inside _ _ _) = True
isInside _		= False

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