View.hs

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 qualified Chiasma.Data.View
import Chiasma.Data.View (View (View))
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 id' (View _ (Just vid)) = id' == vid
sameId _ _ = False

view :: Lens' Views [View a] -> (Ident -> ViewsError) -> Ident -> Views -> Either ViewsError (View a)
view viewsL consError ident =
  maybeToRight (consError ident) . find (sameIdent ident) . Lens.view viewsL

viewById :: Eq a => Lens' Views [View a] -> a -> Views -> Maybe (View a)
viewById viewsL id' =
  find (sameId id') . Lens.view viewsL

insertView :: Lens' Views [View a] -> View a -> Views -> Views
insertView viewsL newView = over viewsL (newView :)

updateView ::
  ∀ a .
  Lens' Views [View a] ->
  (Ident -> ViewsError) ->
  View a ->
  Views ->
  Views
updateView viewsL _ newView =
  set (viewsL . where1 (sameIdent newView.ident)) newView

session :: Ident -> Views -> Either ViewsError (View SessionId)
session = view Views.sessions NoSuchSession

sessionById :: SessionId -> Views -> Maybe (View SessionId)
sessionById = viewById Views.sessions

insertSession :: View SessionId -> Views -> Views
insertSession = insertView Views.sessions

updateSession :: View SessionId -> Views -> Views
updateSession = updateView Views.sessions NoSuchSession

window :: Ident -> Views -> Either ViewsError (View WindowId)
window = view Views.windows NoSuchWindow

windowById :: WindowId -> Views -> Maybe (View WindowId)
windowById = viewById Views.windows

insertWindow :: View WindowId -> Views -> Views
insertWindow = insertView Views.windows

updateWindow :: View WindowId -> Views -> Views
updateWindow = updateView Views.windows NoSuchWindow

pane :: Ident -> Views -> Either ViewsError (View PaneId)
pane = view Views.panes NoSuchPane

paneById :: PaneId -> Views -> Maybe (View PaneId)
paneById = viewById Views.panes

paneId :: Ident -> Views -> Either ViewsError PaneId
paneId paneIdent views =
  pane paneIdent views >>= trans
  where
    trans (View _ (Just paneId')) = Right paneId'
    trans _ = Left $ NoPaneId paneIdent

insertPane :: View PaneId -> Views -> Views
insertPane = insertView Views.panes

updatePane :: View PaneId -> Views -> Views
updatePane = updateView Views.panes 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 message =
  atomicModify' f
  where
    f :: Views -> Views
    f = over Views.log (message :)

viewsLogS ::
  Member (AtomicState Views) r =>
  Text ->
  Sem r ()
viewsLogS =
  viewsLog . pretty

addView ::
  Member (AtomicState Views) r =>
  Setter a ->
  Ident ->
  Sem r (View a)
addView setter ident = do
  atomicModify' (setter newView)
  viewsLogS [exon|added tmux view #{identText ident}|]
  pure newView
  where
    newView =
      View ident Nothing

findOrCreateView ::
  Member (AtomicState Views) r =>
  Getter a ->
  Setter a ->
  Ident ->
  Sem r (View a)
findOrCreateView getter setter ident = do
  existing <- atomicGets (getter ident)
  either (const (addView setter ident)) pure existing