import System.IO

-- Question: Can we represent a pointer to an item in the middle of a
-- list in Haskell, in a way that supports both efficient navigation
-- and editing?

-- Let's introduce a type class describing the operations that a pointer
-- to an item should support.

class ListItem lp where
  headItem :: [a] -> lp a       -- create a pointer to the head of a (non-empty) list
  value :: lp a -> a            -- return the value stored at the pointer
  list :: lp a -> [a]           -- return the underlying list
  movL :: lp a -> lp a          -- move the pointer to the left
  movR :: lp a -> lp a          -- move the pointer to the right
  ovw :: a -> lp a -> lp a      -- overwrite item with new value
  bks :: lp a -> lp a           -- remove the item to the left
  ins :: a -> lp a -> lp a      -- insert a new item to the left

-- Naive solution: store the index i of the element x = xs !! i.

newtype NaiveListItem a = NLI ([a],Int) deriving (Show)

instance ListItem NaiveListItem where
  headItem xs = NLI (xs,0)
  value (NLI (xs,i)) = xs !! i
  list (NLI (xs,_)) = xs
  
  movL (NLI (xs,i)) = NLI (xs,i-1)
  movR (NLI (xs,i)) = NLI (xs,i+1)
  
  ovw y (NLI (xs,i)) = NLI (take i xs ++ [y] ++ drop (i+1) xs,i)
  bks (NLI (xs,i)) = NLI (take (i-1) xs ++ [x] ++ drop (i+1) xs,i-1)
    where x = xs !! i
  ins y (NLI (xs,i)) = NLI (take i xs ++ [y,x] ++ drop (i+1) xs,i+1)
    where x = xs !! i

-- Problem: editing takes time O(n)!

-- Better solution: represent a pointer to an item in a list by the item
-- itself, paired with the lists of elements to its left and to its right.
-- (But we'll store the list of elements to the left in reverse.)
-- The pair of lists may be thought of as a "context" in which to plug the value.

-- This kind of data structure (one-hole context + value) is called a "zipper".

newtype ListZip a = LP ([a],a,[a]) deriving (Show)

instance ListItem ListZip where
  headItem xs = LP ([],head xs,tail xs)
  value (LP (ls,x,rs)) = x
  list (LP (ls,x,rs)) = reverse ls ++ [x] ++ rs
  
  movL (LP (l:ls,x,rs)) = LP (ls,l,x:rs)
  movR (LP (ls,x,r:rs)) = LP (x:ls,r,rs)
  
  ovw y (LP (ls,x,rs)) = LP (ls,y,rs)
  bks (LP (_:ls,x,rs)) = LP (ls,x,rs)
  ins y (LP (ls,x,rs)) = LP (y:ls,x,rs)

-- Now almost all of the operations are O(1)! (Other than list, which is O(n).)

-- Let's observe the zipper in action...
main :: IO ()
main = go init
  where
    init :: ListZip Char
    init = headItem "HELLO WORLD!"
    
    go p = do
      putStrLn ("Current state: " ++ show p)
      putStr "Action? "
      hFlush stdout
      action <- getLine
      case action !! 0 of
        'L' -> go (movL p)
        'R' -> go (movR p)
        'O' -> go (ovw (action !! 1) p)
        'B' -> go (bks p)
        'I' -> go (ins (action !! 1) p)
        'Q' -> do
          putStrLn ("Final result: " ++ list p)
          return ()