module Chiasma.View where

import qualified Control.Lens as Lens
import Exon (exon)
import Prettyprinter (Doc, pretty)
import Prettyprinter.Render.Terminal (AnsiStyle)

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)

sameId :: Eq a => a -> View a -> Bool
sameId :: forall a. Eq a => 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 :: forall a.
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 :: forall a.
Eq a =>
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 :: forall a. 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
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 :: forall a.
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
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

viewsLog ::
  Member (AtomicState Views) r =>
  Doc AnsiStyle ->
  Sem r ()
viewsLog :: forall (r :: EffectRow).
Member (AtomicState Views) r =>
Doc AnsiStyle -> Sem r ()
viewsLog Doc AnsiStyle
message =
  (Views -> Views) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' 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 ::
  Member (AtomicState Views) r =>
  Text ->
  Sem r ()
viewsLogS :: forall (r :: EffectRow).
Member (AtomicState Views) r =>
Text -> Sem r ()
viewsLogS =
  Doc AnsiStyle -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Doc AnsiStyle -> Sem r ()
viewsLog (Doc AnsiStyle -> Sem r ())
-> (Text -> Doc AnsiStyle) -> Text -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty

addView ::
  Member (AtomicState Views) r =>
  Setter a ->
  Ident ->
  Sem r (View a)
addView :: forall (r :: EffectRow) a.
Member (AtomicState Views) r =>
Setter a -> Ident -> Sem r (View a)
addView Setter a
setter Ident
ident = do
  (Views -> Views) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (Setter a
setter View a
newView)
  Text -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Text -> Sem r ()
viewsLogS [exon|added tmux view #{identText ident}|]
  pure 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 ::
  Member (AtomicState Views) r =>
  Getter a ->
  Setter a ->
  Ident ->
  Sem r (View a)
findOrCreateView :: forall (r :: EffectRow) a.
Member (AtomicState Views) r =>
Getter a -> Setter a -> Ident -> Sem r (View a)
findOrCreateView Getter a
getter Setter a
setter Ident
ident = do
  Either ViewsError (View a)
existing <- (Views -> Either ViewsError (View a))
-> Sem r (Either ViewsError (View a))
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets (Getter a
getter Ident
ident)
  (ViewsError -> Sem r (View a))
-> (View a -> Sem r (View a))
-> Either ViewsError (View a)
-> Sem r (View a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Sem r (View a) -> ViewsError -> Sem r (View a)
forall a b. a -> b -> a
const (Setter a -> Ident -> Sem r (View a)
forall (r :: EffectRow) a.
Member (AtomicState Views) r =>
Setter a -> Ident -> Sem r (View a)
addView Setter a
setter Ident
ident)) View a -> Sem r (View a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ViewsError (View a)
existing