module Rahm.Desktop.History
  ( zipperDbgPrint,
    pushZipper,
    getZipper,
    zipperBack,
    zipperForward,
    pastHistory,
    getMostRecentLocationInHistory,
    historyBack,
    historyForward,
    lastLocation,
    nextLocation,
    jumpToLastLocation,
    historyHook,
  )
where

import Data.Default (Default (..))
import Data.Foldable (toList)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq (length, (!?))
import Rahm.Desktop.Common (Location (Location), focusLocation)
import Text.Printf (printf)
import XMonad (ExtensionClass (extensionType, initialValue), StateExtension (..), X)
import qualified XMonad.Util.ExtensibleState as XS
  ( get,
    modify,
    put,
  )

data BoundedSeqZipper a = BoundedSeqZipper Int (Seq a) (Seq a)
  deriving (Eq, Show, Ord, Read)

instance Functor BoundedSeqZipper where
  fmap fn (BoundedSeqZipper i h t) = BoundedSeqZipper i (fmap fn h) (fmap fn t)

zipperDbgPrint :: (Show a) => BoundedSeqZipper a -> String
zipperDbgPrint (BoundedSeqZipper _ h (c :<| t)) =
  concat $
    map (printf " %s " . show) (toList h)
      ++ [printf "[%s]" (show c)]
      ++ map (printf " %s " . show) (toList t)
zipperDbgPrint _ = "<empty>"

pushZipper :: a -> BoundedSeqZipper a -> BoundedSeqZipper a
pushZipper e (BoundedSeqZipper maxSize _ (tail :|> _))
  | maxSize <= Seq.length tail =
    BoundedSeqZipper maxSize mempty (e :<| tail)
pushZipper e (BoundedSeqZipper maxSize _ tail) =
  BoundedSeqZipper maxSize mempty (e :<| tail)

getZipper :: BoundedSeqZipper a -> Maybe a
getZipper (BoundedSeqZipper _ _ (e :<| _)) = Just e
getZipper _ = Nothing

zipperBack :: BoundedSeqZipper a -> BoundedSeqZipper a
zipperBack (BoundedSeqZipper s h (e :<| t)) = BoundedSeqZipper s (e :<| h) t
zipperBack b = b

zipperForward :: BoundedSeqZipper a -> BoundedSeqZipper a
zipperForward (BoundedSeqZipper s (e :<| h) t) = BoundedSeqZipper s h (e :<| t)
zipperForward b = b

newtype History = History
  { currentZipper :: BoundedSeqZipper Location
  }
  deriving (Read, Show)

instance Default History where
  def = History (BoundedSeqZipper 1000 mempty mempty)

instance ExtensionClass History where
  initialValue = def
  extensionType = PersistentExtension

pastHistory :: Int -> X (Maybe Location)
pastHistory i = do
  History (BoundedSeqZipper _ _ t) <- XS.get
  return $ t Seq.!? i

getMostRecentLocationInHistory :: X (Maybe Location)
getMostRecentLocationInHistory = do
  History z <- XS.get
  case z of
    (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
    (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
    _ -> return Nothing

historyBack :: X ()
historyBack = do
  History z <- XS.get
  let z' = zipperBack z
  mapM_ focusLocation (getZipper z')
  XS.put (History z')

historyForward :: X ()
historyForward = do
  History z <- XS.get
  let z' = zipperForward z
  mapM_ focusLocation (getZipper z')
  XS.put (History z')

lastLocation :: X (Maybe Location)
lastLocation = getZipper . zipperBack . currentZipper <$> XS.get

nextLocation :: X (Maybe Location)
nextLocation = getZipper . zipperForward . currentZipper <$> XS.get

jumpToLastLocation :: X ()
jumpToLastLocation = mapM_ focusLocation =<< lastLocation

historyHook :: Maybe Location -> Location -> X ()
historyHook Nothing loc =
  XS.modify $ \(History z) -> History (pushZipper loc z)
historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do
  XS.modify $ \(History z) -> History (pushZipper l z)
historyHook _ _ = return ()