{-# LANGUAGE TemplateHaskell #-}

module Taskell.Events.State.Types where

import ClassyPrelude

import Control.Lens             (Lens', makeLenses)
import Control.Lens.Combinators (_1, _2)

import Data.Time.Zones (TZ)

import Taskell.Data.Lists    (Lists)
import Taskell.Types         (Pointer, startPointer)
import Taskell.UI.Draw.Field (Field)

import qualified Taskell.Events.State.Types.Mode as M (Mode)

type Moment = (Pointer, Lists)

data History a = History
    { History a -> [a]
_past    :: [a]
    , History a -> a
_present :: a
    , History a -> [a]
_future  :: [a]
    } deriving (History a -> History a -> Bool
(History a -> History a -> Bool)
-> (History a -> History a -> Bool) -> Eq (History a)
forall a. Eq a => History a -> History a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: History a -> History a -> Bool
$c/= :: forall a. Eq a => History a -> History a -> Bool
== :: History a -> History a -> Bool
$c== :: forall a. Eq a => History a -> History a -> Bool
Eq, Int -> History a -> ShowS
[History a] -> ShowS
History a -> String
(Int -> History a -> ShowS)
-> (History a -> String)
-> ([History a] -> ShowS)
-> Show (History a)
forall a. Show a => Int -> History a -> ShowS
forall a. Show a => [History a] -> ShowS
forall a. Show a => History a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [History a] -> ShowS
$cshowList :: forall a. Show a => [History a] -> ShowS
show :: History a -> String
$cshow :: forall a. Show a => History a -> String
showsPrec :: Int -> History a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> History a -> ShowS
Show)

fresh :: Lists -> History Moment
fresh :: Lists -> History Moment
fresh Lists
ls = [Moment] -> Moment -> [Moment] -> History Moment
forall a. [a] -> a -> [a] -> History a
History [Moment]
forall (f :: * -> *) a. Alternative f => f a
empty (Pointer
startPointer, Lists
ls) [Moment]
forall (f :: * -> *) a. Alternative f => f a
empty

data State = State
    { State -> Mode
_mode       :: M.Mode
    , State -> History Moment
_history    :: History Moment
    , State -> String
_path       :: FilePath
    , State -> Maybe Lists
_io         :: Maybe Lists
    , State -> Int
_height     :: Int
    , State -> Maybe Field
_searchTerm :: Maybe Field
    , State -> UTCTime
_time       :: UTCTime
    , State -> TZ
_timeZone   :: TZ
    } deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

-- create lenses
$(makeLenses ''State)

$(makeLenses ''History)

type Stateful = State -> Maybe State

current :: Lens' State Pointer
current :: (Pointer -> f Pointer) -> State -> f State
current = (History Moment -> f (History Moment)) -> State -> f State
Lens' State (History Moment)
history ((History Moment -> f (History Moment)) -> State -> f State)
-> ((Pointer -> f Pointer) -> History Moment -> f (History Moment))
-> (Pointer -> f Pointer)
-> State
-> f State
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Moment -> f Moment) -> History Moment -> f (History Moment)
forall a. Lens' (History a) a
present ((Moment -> f Moment) -> History Moment -> f (History Moment))
-> ((Pointer -> f Pointer) -> Moment -> f Moment)
-> (Pointer -> f Pointer)
-> History Moment
-> f (History Moment)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pointer -> f Pointer) -> Moment -> f Moment
forall s t a b. Field1 s t a b => Lens s t a b
_1

lists :: Lens' State Lists
lists :: (Lists -> f Lists) -> State -> f State
lists = (History Moment -> f (History Moment)) -> State -> f State
Lens' State (History Moment)
history ((History Moment -> f (History Moment)) -> State -> f State)
-> ((Lists -> f Lists) -> History Moment -> f (History Moment))
-> (Lists -> f Lists)
-> State
-> f State
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Moment -> f Moment) -> History Moment -> f (History Moment)
forall a. Lens' (History a) a
present ((Moment -> f Moment) -> History Moment -> f (History Moment))
-> ((Lists -> f Lists) -> Moment -> f Moment)
-> (Lists -> f Lists)
-> History Moment
-> f (History Moment)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Lists -> f Lists) -> Moment -> f Moment
forall s t a b. Field2 s t a b => Lens s t a b
_2