{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE TemplateHaskell    #-}

module Yi.JumpList
    ( JumpList
    , Jump(..)
    , addJump
    , jumpBack
    , jumpForward
    ) where

import           GHC.Generics          (Generic)

import           Data.Binary           (Binary)
import           Data.List.PointedList as PL (PointedList (..), next, previous)
import           Yi.Buffer.Basic       (BufferRef, Mark)


type JumpList = Maybe (PL.PointedList Jump)

data Jump = Jump {
        Jump -> Mark
jumpMark      :: Mark
      , Jump -> BufferRef
jumpBufferRef :: BufferRef
    } deriving ((forall x. Jump -> Rep Jump x)
-> (forall x. Rep Jump x -> Jump) -> Generic Jump
forall x. Rep Jump x -> Jump
forall x. Jump -> Rep Jump x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Jump x -> Jump
$cfrom :: forall x. Jump -> Rep Jump x
Generic)

instance Binary Jump

instance Show Jump where
    show :: Jump -> String
show (Jump Mark
mark BufferRef
bufref) = String
"<Jump " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Mark -> String
forall a. Show a => a -> String
show Mark
mark String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BufferRef -> String
forall a. Show a => a -> String
show BufferRef
bufref String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

addJump :: Jump -> JumpList -> JumpList
addJump :: Jump -> JumpList -> JumpList
addJump Jump
j (Just (PL.PointedList [Jump]
past Jump
present [Jump]
_future)) = PointedList Jump -> JumpList
forall a. a -> Maybe a
Just (PointedList Jump -> JumpList) -> PointedList Jump -> JumpList
forall a b. (a -> b) -> a -> b
$ [Jump] -> Jump -> [Jump] -> PointedList Jump
forall a. [a] -> a -> [a] -> PointedList a
PL.PointedList (Jump
presentJump -> [Jump] -> [Jump]
forall a. a -> [a] -> [a]
:[Jump]
past) Jump
j []
addJump Jump
j JumpList
Nothing = PointedList Jump -> JumpList
forall a. a -> Maybe a
Just (PointedList Jump -> JumpList) -> PointedList Jump -> JumpList
forall a b. (a -> b) -> a -> b
$ [Jump] -> Jump -> [Jump] -> PointedList Jump
forall a. [a] -> a -> [a] -> PointedList a
PL.PointedList [] Jump
j []

jumpBack :: JumpList -> JumpList
jumpBack :: JumpList -> JumpList
jumpBack = (PointedList Jump -> JumpList) -> JumpList -> JumpList
modifyJumpList PointedList Jump -> JumpList
forall a. PointedList a -> Maybe (PointedList a)
previous

jumpForward :: JumpList -> JumpList
jumpForward :: JumpList -> JumpList
jumpForward = (PointedList Jump -> JumpList) -> JumpList -> JumpList
modifyJumpList PointedList Jump -> JumpList
forall a. PointedList a -> Maybe (PointedList a)
next

modifyJumpList :: (PointedList Jump -> Maybe (PointedList Jump)) -> JumpList -> JumpList
modifyJumpList :: (PointedList Jump -> JumpList) -> JumpList -> JumpList
modifyJumpList PointedList Jump -> JumpList
f (Just PointedList Jump
jumps) = case PointedList Jump -> JumpList
f PointedList Jump
jumps of
                                JumpList
Nothing -> PointedList Jump -> JumpList
forall a. a -> Maybe a
Just PointedList Jump
jumps
                                Just PointedList Jump
jumps' -> PointedList Jump -> JumpList
forall a. a -> Maybe a
Just PointedList Jump
jumps'
modifyJumpList PointedList Jump -> JumpList
_ JumpList
Nothing = JumpList
forall a. Maybe a
Nothing