{-# 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