{-# LANGUAGE RankNTypes #-}

module Chiasma.View where

import Chiasma.Data.Ident (Ident, identText, sameIdent)
import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)
import Chiasma.Data.View (View(View), viewIdent)
import Chiasma.Data.Views (Views, ViewsError(..))
import qualified Chiasma.Data.Views as Views (log, panes, sessions, windows)
import Chiasma.Lens.Where (where1)
import Control.Lens (Lens', over)
import qualified Control.Lens as Lens (over, set, view)
import Data.Text.Prettyprint.Doc (Doc, pretty)
import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)

sameId :: Eq a => a -> View a -> Bool
sameId :: a -> View a -> Bool
sameId a
id' (View Ident
_ (Just a
vid)) = a
id' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
vid
sameId a
_ View a
_ = Bool
False

view :: Lens' Views [View a] -> (Ident -> ViewsError) -> Ident -> Views -> Either ViewsError (View a)
view :: Lens' Views [View a]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View a)
view Lens' Views [View a]
viewsL Ident -> ViewsError
consError Ident
ident =
  ViewsError -> Maybe (View a) -> Either ViewsError (View a)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Ident -> ViewsError
consError Ident
ident) (Maybe (View a) -> Either ViewsError (View a))
-> (Views -> Maybe (View a)) -> Views -> Either ViewsError (View a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View a -> Bool) -> [View a] -> Maybe (View a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Ident -> View a -> Bool
forall a b. (Identifiable a, Identifiable b) => a -> b -> Bool
sameIdent Ident
ident) ([View a] -> Maybe (View a))
-> (Views -> [View a]) -> Views -> Maybe (View a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [View a] Views [View a] -> Views -> [View a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting [View a] Views [View a]
Lens' Views [View a]
viewsL

viewById :: Eq a => Lens' Views [View a] -> a -> Views -> Maybe (View a)
viewById :: Lens' Views [View a] -> a -> Views -> Maybe (View a)
viewById Lens' Views [View a]
viewsL a
id' =
  (View a -> Bool) -> [View a] -> Maybe (View a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> View a -> Bool
forall a. Eq a => a -> View a -> Bool
sameId a
id') ([View a] -> Maybe (View a))
-> (Views -> [View a]) -> Views -> Maybe (View a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [View a] Views [View a] -> Views -> [View a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting [View a] Views [View a]
Lens' Views [View a]
viewsL

insertView :: Lens' Views [View a] -> View a -> Views -> Views
insertView :: Lens' Views [View a] -> View a -> Views -> Views
insertView Lens' Views [View a]
viewsL View a
newView = ASetter Views Views [View a] [View a]
-> ([View a] -> [View a]) -> Views -> Views
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter Views Views [View a] [View a]
Lens' Views [View a]
viewsL (View a
newView View a -> [View a] -> [View a]
forall a. a -> [a] -> [a]
:)

updateView :: Lens' Views [View a] -> (Ident -> ViewsError) -> View a -> Views -> Views
updateView :: Lens' Views [View a]
-> (Ident -> ViewsError) -> View a -> Views -> Views
updateView Lens' Views [View a]
viewsL Ident -> ViewsError
_ View a
newView =
  ASetter Views Views (View a) (View a) -> View a -> Views -> Views
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set (([View a] -> Identity [View a]) -> Views -> Identity Views
Lens' Views [View a]
viewsL (([View a] -> Identity [View a]) -> Views -> Identity Views)
-> ((View a -> Identity (View a)) -> [View a] -> Identity [View a])
-> ASetter Views Views (View a) (View a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View a -> Bool)
-> (View a -> Identity (View a)) -> [View a] -> Identity [View a]
forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Traversable t) =>
(a -> Bool) -> Over (->) f (t a) (t a) a a
where1 (Ident -> View a -> Bool
forall a b. (Identifiable a, Identifiable b) => a -> b -> Bool
sameIdent (View a -> Ident
forall a. View a -> Ident
viewIdent View a
newView))) View a
newView

session :: Ident -> Views -> Either ViewsError (View SessionId)
session :: Ident -> Views -> Either ViewsError (View SessionId)
session = Lens' Views [View SessionId]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View SessionId)
forall a.
Lens' Views [View a]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View a)
view forall c. HasViews c => Lens' c [View SessionId]
Lens' Views [View SessionId]
Views.sessions Ident -> ViewsError
NoSuchSession

sessionById :: SessionId -> Views -> Maybe (View SessionId)
sessionById :: SessionId -> Views -> Maybe (View SessionId)
sessionById = Lens' Views [View SessionId]
-> SessionId -> Views -> Maybe (View SessionId)
forall a.
Eq a =>
Lens' Views [View a] -> a -> Views -> Maybe (View a)
viewById forall c. HasViews c => Lens' c [View SessionId]
Lens' Views [View SessionId]
Views.sessions

insertSession :: View SessionId -> Views -> Views
insertSession :: View SessionId -> Views -> Views
insertSession = Lens' Views [View SessionId] -> View SessionId -> Views -> Views
forall a. Lens' Views [View a] -> View a -> Views -> Views
insertView forall c. HasViews c => Lens' c [View SessionId]
Lens' Views [View SessionId]
Views.sessions

updateSession :: View SessionId -> Views -> Views
updateSession :: View SessionId -> Views -> Views
updateSession = Lens' Views [View SessionId]
-> (Ident -> ViewsError) -> View SessionId -> Views -> Views
forall a.
Lens' Views [View a]
-> (Ident -> ViewsError) -> View a -> Views -> Views
updateView forall c. HasViews c => Lens' c [View SessionId]
Lens' Views [View SessionId]
Views.sessions Ident -> ViewsError
NoSuchSession

window :: Ident -> Views -> Either ViewsError (View WindowId)
window :: Ident -> Views -> Either ViewsError (View WindowId)
window = Lens' Views [View WindowId]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View WindowId)
forall a.
Lens' Views [View a]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View a)
view forall c. HasViews c => Lens' c [View WindowId]
Lens' Views [View WindowId]
Views.windows Ident -> ViewsError
NoSuchWindow

windowById :: WindowId -> Views -> Maybe (View WindowId)
windowById :: WindowId -> Views -> Maybe (View WindowId)
windowById = Lens' Views [View WindowId]
-> WindowId -> Views -> Maybe (View WindowId)
forall a.
Eq a =>
Lens' Views [View a] -> a -> Views -> Maybe (View a)
viewById forall c. HasViews c => Lens' c [View WindowId]
Lens' Views [View WindowId]
Views.windows

insertWindow :: View WindowId -> Views -> Views
insertWindow :: View WindowId -> Views -> Views
insertWindow = Lens' Views [View WindowId] -> View WindowId -> Views -> Views
forall a. Lens' Views [View a] -> View a -> Views -> Views
insertView forall c. HasViews c => Lens' c [View WindowId]
Lens' Views [View WindowId]
Views.windows

updateWindow :: View WindowId -> Views -> Views
updateWindow :: View WindowId -> Views -> Views
updateWindow = Lens' Views [View WindowId]
-> (Ident -> ViewsError) -> View WindowId -> Views -> Views
forall a.
Lens' Views [View a]
-> (Ident -> ViewsError) -> View a -> Views -> Views
updateView forall c. HasViews c => Lens' c [View WindowId]
Lens' Views [View WindowId]
Views.windows Ident -> ViewsError
NoSuchWindow

pane :: Ident -> Views -> Either ViewsError (View PaneId)
pane :: Ident -> Views -> Either ViewsError (View PaneId)
pane = Lens' Views [View PaneId]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View PaneId)
forall a.
Lens' Views [View a]
-> (Ident -> ViewsError)
-> Ident
-> Views
-> Either ViewsError (View a)
view forall c. HasViews c => Lens' c [View PaneId]
Lens' Views [View PaneId]
Views.panes Ident -> ViewsError
NoSuchPane

paneById :: PaneId -> Views -> Maybe (View PaneId)
paneById :: PaneId -> Views -> Maybe (View PaneId)
paneById = Lens' Views [View PaneId] -> PaneId -> Views -> Maybe (View PaneId)
forall a.
Eq a =>
Lens' Views [View a] -> a -> Views -> Maybe (View a)
viewById forall c. HasViews c => Lens' c [View PaneId]
Lens' Views [View PaneId]
Views.panes

paneId :: Ident -> Views -> Either ViewsError PaneId
paneId :: Ident -> Views -> Either ViewsError PaneId
paneId Ident
paneIdent Views
views =
  Ident -> Views -> Either ViewsError (View PaneId)
pane Ident
paneIdent Views
views Either ViewsError (View PaneId)
-> (View PaneId -> Either ViewsError PaneId)
-> Either ViewsError PaneId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= View PaneId -> Either ViewsError PaneId
trans
  where
    trans :: View PaneId -> Either ViewsError PaneId
trans (View Ident
_ (Just PaneId
paneId')) = PaneId -> Either ViewsError PaneId
forall a b. b -> Either a b
Right PaneId
paneId'
    trans View PaneId
_ = ViewsError -> Either ViewsError PaneId
forall a b. a -> Either a b
Left (ViewsError -> Either ViewsError PaneId)
-> ViewsError -> Either ViewsError PaneId
forall a b. (a -> b) -> a -> b
$ Ident -> ViewsError
NoPaneId Ident
paneIdent

insertPane :: View PaneId -> Views -> Views
insertPane :: View PaneId -> Views -> Views
insertPane = Lens' Views [View PaneId] -> View PaneId -> Views -> Views
forall a. Lens' Views [View a] -> View a -> Views -> Views
insertView forall c. HasViews c => Lens' c [View PaneId]
Lens' Views [View PaneId]
Views.panes

updatePane :: View PaneId -> Views -> Views
updatePane :: View PaneId -> Views -> Views
updatePane = Lens' Views [View PaneId]
-> (Ident -> ViewsError) -> View PaneId -> Views -> Views
forall a.
Lens' Views [View a]
-> (Ident -> ViewsError) -> View a -> Views -> Views
updateView forall c. HasViews c => Lens' c [View PaneId]
Lens' Views [View PaneId]
Views.panes Ident -> ViewsError
NoSuchPane

type Getter a = Ident -> Views -> Either ViewsError (View a)
type Setter a = View a -> Views -> Views

addView :: MonadDeepState s Views m => Setter a -> Ident -> m (View a)
addView :: Setter a -> Ident -> m (View a)
addView Setter a
setter Ident
ident = do
  (Views -> Views) -> m ()
forall s' s (m :: * -> *).
MonadDeepState s s' m =>
(s' -> s') -> m ()
modify ((Views -> Views) -> m ()) -> (Views -> Views) -> m ()
forall a b. (a -> b) -> a -> b
$ Setter a
setter View a
newView
  Text -> m ()
forall s (m :: * -> *). MonadDeepState s Views m => Text -> m ()
viewsLogS (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"added tmux view " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident
  return View a
newView
  where
    newView :: View a
newView = Ident -> Maybe a -> View a
forall a. Ident -> Maybe a -> View a
View Ident
ident Maybe a
forall a. Maybe a
Nothing

findOrCreateView :: (MonadDeepState s Views m) => Getter a -> Setter a -> Ident -> m (View a)
findOrCreateView :: Getter a -> Setter a -> Ident -> m (View a)
findOrCreateView Getter a
getter Setter a
setter Ident
ident = do
  Either ViewsError (View a)
existing <- (Views -> Either ViewsError (View a))
-> m (Either ViewsError (View a))
forall s' s (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> a) -> m a
gets ((Views -> Either ViewsError (View a))
 -> m (Either ViewsError (View a)))
-> (Views -> Either ViewsError (View a))
-> m (Either ViewsError (View a))
forall a b. (a -> b) -> a -> b
$ Getter a
getter Ident
ident
  (ViewsError -> m (View a))
-> (View a -> m (View a))
-> Either ViewsError (View a)
-> m (View a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (View a) -> ViewsError -> m (View a)
forall a b. a -> b -> a
const (m (View a) -> ViewsError -> m (View a))
-> m (View a) -> ViewsError -> m (View a)
forall a b. (a -> b) -> a -> b
$ Setter a -> Ident -> m (View a)
forall s (m :: * -> *) a.
MonadDeepState s Views m =>
Setter a -> Ident -> m (View a)
addView Setter a
setter Ident
ident) View a -> m (View a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either ViewsError (View a)
existing

viewsLog :: MonadDeepState s Views m => Doc AnsiStyle -> m ()
viewsLog :: Doc AnsiStyle -> m ()
viewsLog Doc AnsiStyle
message =
  (Views -> Views) -> m ()
forall s' s (m :: * -> *).
MonadDeepState s s' m =>
(s' -> s') -> m ()
modify Views -> Views
f
  where
    f :: Views -> Views
    f :: Views -> Views
f = ASetter Views Views [Doc AnsiStyle] [Doc AnsiStyle]
-> ([Doc AnsiStyle] -> [Doc AnsiStyle]) -> Views -> Views
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Views Views [Doc AnsiStyle] [Doc AnsiStyle]
forall c. HasViews c => Lens' c [Doc AnsiStyle]
Views.log (Doc AnsiStyle
message Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. a -> [a] -> [a]
:)

viewsLogS :: MonadDeepState s Views m => Text -> m ()
viewsLogS :: Text -> m ()
viewsLogS =
  Doc AnsiStyle -> m ()
forall s (m :: * -> *).
MonadDeepState s Views m =>
Doc AnsiStyle -> m ()
viewsLog (Doc AnsiStyle -> m ()) -> (Text -> Doc AnsiStyle) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty