module Taskell.Events.State.History
    ( undo
    , redo
    , store
    ) where

import ClassyPrelude

import Control.Lens (Lens', (&), (.~), (^.))

import Taskell.Events.State.Types (History (History), future, past, present)

λstack :: Lens' (History a) [a] -> History a -> [a]
λstack :: Lens' (History a) [a] -> History a -> [a]
λstack Lens' (History a) [a]
fn History a
history = History a
history History a -> Getting a (History a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (History a) a
forall a. Lens' (History a) a
present a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (History a
history History a -> Getting [a] (History a) [a] -> [a]
forall s a. s -> Getting a s a -> a
^. Getting [a] (History a) [a]
Lens' (History a) [a]
fn)

store :: History a -> History a
store :: History a -> History a
store History a
history = History a
history History a -> (History a -> History a) -> History a
forall a b. a -> (a -> b) -> b
& ([a] -> Identity [a]) -> History a -> Identity (History a)
forall a. Lens' (History a) [a]
past (([a] -> Identity [a]) -> History a -> Identity (History a))
-> [a] -> History a -> History a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Lens' (History a) [a] -> History a -> [a]
forall a. Lens' (History a) [a] -> History a -> [a]
λstack forall a. Lens' (History a) [a]
Lens' (History a) [a]
past History a
history History a -> (History a -> History a) -> History a
forall a b. a -> (a -> b) -> b
& ([a] -> Identity [a]) -> History a -> Identity (History a)
forall a. Lens' (History a) [a]
future (([a] -> Identity [a]) -> History a -> Identity (History a))
-> [a] -> History a -> History a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [a]
forall (f :: * -> *) a. Alternative f => f a
empty

undo :: History a -> History a
undo :: History a -> History a
undo History a
history =
    case History a
history History a -> Getting [a] (History a) [a] -> [a]
forall s a. s -> Getting a s a -> a
^. Getting [a] (History a) [a]
forall a. Lens' (History a) [a]
past of
        []          -> History a
history
        (a
moment:[a]
xs) -> [a] -> a -> [a] -> History a
forall a. [a] -> a -> [a] -> History a
History [a]
xs a
moment (Lens' (History a) [a] -> History a -> [a]
forall a. Lens' (History a) [a] -> History a -> [a]
λstack forall a. Lens' (History a) [a]
Lens' (History a) [a]
future History a
history)

redo :: History a -> History a
redo :: History a -> History a
redo History a
history =
    case History a
history History a -> Getting [a] (History a) [a] -> [a]
forall s a. s -> Getting a s a -> a
^. Getting [a] (History a) [a]
forall a. Lens' (History a) [a]
future of
        []          -> History a
history
        (a
moment:[a]
xs) -> [a] -> a -> [a] -> History a
forall a. [a] -> a -> [a] -> History a
History (Lens' (History a) [a] -> History a -> [a]
forall a. Lens' (History a) [a] -> History a -> [a]
λstack forall a. Lens' (History a) [a]
Lens' (History a) [a]
past History a
history) a
moment [a]
xs