packages feed

rasa-ext-views (empty) → 0.1.1

raw patch · 7 files changed

+440/−0 lines, 7 filesdep +basedep +bifunctorsdep +data-defaultsetup-changed

Dependencies added: base, bifunctors, data-default, lens, mtl, rasa, recursion-schemes

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2016 Chris Penner++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rasa-ext-views.cabal view
@@ -0,0 +1,37 @@+name: rasa-ext-views+version: 0.1.1+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: 2016 Chris Penner+maintainer: christopher.penner@gmail.com+homepage: https://github.com/ChrisPenner/rasa/+synopsis: Rasa Ext managing rendering views+description:+    Rasa Ext managing rendering views+category: Extension+author: Chris Penner++source-repository head+    type: git+    location: https://github.com/ChrisPenner/rasa++library+    exposed-modules:+        Rasa.Ext.Views+        Rasa.Ext.Views.Internal.BiTree+        Rasa.Ext.Views.Internal.Views+        Rasa.Ext.Views.Internal.Actions+    build-depends:+        base >=4.8 && <5,+        rasa >=0.1.5 && <0.2,+        lens ==4.14.*,+        data-default >=0.7.1.1 && <0.8,+        bifunctors >=5.4.1 && <5.5,+        recursion-schemes >=5.0.1 && <5.1,+        mtl >=2.2.1 && <2.3+    default-language: Haskell2010+    hs-source-dirs: src+    ghc-options: -Wall+
+ src/Rasa/Ext/Views.hs view
@@ -0,0 +1,34 @@+module Rasa.Ext.Views+  (+  views+  , getViews+  , getBufferViews+  , bufRef+  , splitRule+  , active+  , A.rotate+  , A.closeInactive+  , A.focusViewLeft+  , A.focusViewRight+  , A.focusViewAbove+  , A.focusViewBelow+  , A.hSplit+  , A.vSplit+  , A.addSplit+  , A.nextBuf+  , A.prevBuf+  , A.focusDo+  , A.focusedBufs+  , Dir(..)+  , SplitRule(..)+  , Window+  , Split(..)+  , Views(..)+  , View(..)+  , BiTree(..)+  , BiTreeF(..)+  ) where++import Rasa.Ext.Views.Internal.BiTree+import Rasa.Ext.Views.Internal.Views+import Rasa.Ext.Views.Internal.Actions as A
+ src/Rasa/Ext/Views/Internal/Actions.hs view
@@ -0,0 +1,94 @@+module Rasa.Ext.Views.Internal.Actions where++import Rasa.Ext+import qualified Rasa.Ext.Views.Internal.Views as V+import Rasa.Ext.Views.Internal.BiTree++import Control.Lens+import Data.Maybe+import Data.List++-- | Main export from the views extension, add this to your rasa config.+views :: Scheduler ()+views = onBufAdded addSplit++-- | Flip all Horizontal splits to Vertical ones and vice versa.+rotate :: Action ()+rotate = V.windows._Just %= V.rotate++-- | Move focus from any viewports one viewport to the left+focusViewLeft :: Action ()+focusViewLeft = V.windows._Just %= V.focusViewLeft++-- | Move focus from any viewports one viewport to the right+focusViewRight :: Action ()+focusViewRight = V.windows._Just %= V.focusViewRight++-- | Move focus from any viewports one viewport above+focusViewAbove :: Action ()+focusViewAbove = V.windows._Just %= V.focusViewAbove++-- | Move focus from any viewports one viewport below+focusViewBelow :: Action ()+focusViewBelow = V.windows._Just %= V.focusViewBelow++-- | Close all inactive viewports+closeInactive :: Action ()+closeInactive = V.windows %= (>>= V.closeBy (not . view V.active))++-- | Split active views horizontally+hSplit :: Action ()+hSplit = V.windows._Just %= V.hSplit++-- | Split active views vertically+vSplit :: Action ()+vSplit = V.windows._Just %= V.vSplit++-- | Add a new split at the top level in the given direction containing the given buffer.+addSplit :: BufRef -> Action ()+addSplit bRef = do+  mWin <- use V.windows+  case mWin of+    Nothing -> V.windows ?= Leaf (V.View True bRef)+    Just win -> V.windows ?= V.addSplit V.Vert bRef win++-- | Select the next buffer in any active viewports+nextBuf :: Action ()+nextBuf = do+  mWin <- use V.windows+  case mWin of+    Nothing -> return ()+    Just win -> V.windows._Just <~ traverse next win+  where+    next vw =+      if vw ^. V.active+          then do+            newBufRef <- nextBufRef (vw ^. V.bufRef)+            return (vw & V.bufRef .~ newBufRef)+          else return vw++-- | Select the previous buffer in any active viewports+prevBuf :: Action ()+prevBuf = do+  mWin <- use V.windows+  case mWin of+    Nothing -> return ()+    Just win -> V.windows._Just <~ traverse prev win+  where+    prev vw =+      if vw ^. V.active+         then do+           newBufRef <- prevBufRef (vw ^. V.bufRef)+           return (vw & V.bufRef .~ newBufRef)+         else return vw++-- | Get bufRefs for all buffers that are selected in at least one viewport+focusedBufs :: Action [BufRef]+focusedBufs = use $ V.windows._Just.to activeBufRefs.to nub+  where activeBufRefs = toListOf $ traverse . filtered (view V.active) . V.bufRef++-- | Run a bufAction over all focused buffers and return any results.+focusDo :: BufAction a -> Action [a]+focusDo bufAct = do+  bufRefs <- focusedBufs+  catMaybes <$> mapM (`bufDo` bufAct) bufRefs
+ src/Rasa/Ext/Views/Internal/BiTree.hs view
@@ -0,0 +1,29 @@+{-# language DeriveFunctor, DeriveTraversable, TypeFamilies  #-}+module Rasa.Ext.Views.Internal.BiTree where++import Data.Typeable+import Data.Bifunctor+import Data.Functor.Foldable++data BiTree b l =+  Branch b (BiTree b l) (BiTree b l)+    | Leaf l+    deriving (Show, Typeable, Functor, Traversable, Foldable)++instance Bifunctor BiTree where+  bimap _ g (Leaf x) = Leaf (g x)+  bimap f g (Branch b l r) = Branch (f b) (bimap f g l) (bimap f g r)++data BiTreeF b l r =+  BranchF b r r+    | LeafF l+    deriving (Show, Functor, Typeable)++type instance Base (BiTree a b) = BiTreeF a b+instance Recursive (BiTree a b) where+  project (Leaf x) = LeafF x+  project (Branch s l r) = BranchF s l r++instance Corecursive (BiTree a b) where+  embed (BranchF sp x xs) = Branch sp x xs+  embed (LeafF x) = Leaf x
+ src/Rasa/Ext/Views/Internal/Views.hs view
@@ -0,0 +1,223 @@+{-# language FlexibleInstances, TemplateHaskell, DeriveFunctor #-}+module Rasa.Ext.Views.Internal.Views+  ( getViews+  , rotate+  , splitRule+  , active+  , bufRef+  , closeBy+  , focusViewLeft+  , focusViewRight+  , focusViewAbove+  , focusViewBelow+  , windows+  , hSplit+  , vSplit+  , addSplit+  , getBufferViews+  , Dir(..)+  , SplitRule(..)+  , Window+  , Split(..)+  , Views(..)+  , View(..)+  , BiTree(..)+  , BiTreeF(..)+  ) where++import Rasa.Ext+import Rasa.Ext.Views.Internal.BiTree++import Control.Lens+import Control.Monad.State+import Data.Default+import Data.Functor.Foldable++-- | A 'SplitRule' determines size of each half of the split.+--+-- - @Ratio Double@ sets the split to the given ratio; the double must be+-- between 0 and 1; for example a value of @0.25@ sets the first portion of the+-- split to 1/4 of the available space; the other portion takes the remaining+-- 3/4 of the space+--+-- - @FromStart Int@ makes the first half of the split (top/left respectively)+-- the set number of rows or columns respectively, the other half of the split+-- gets the rest.+--+-- - @FromEnd Int@ makes the first half of the split (top/left respectively)+-- the set number of rows or columns respectively, the other half of the split+-- gets the rest.++data SplitRule =+  Ratio Double+  | FromStart Int+  | FromEnd Int+  deriving (Show)++instance Default SplitRule where+  def = Ratio 0.5++-- | - 'Hor' denotes a horizontal split.+-- - 'Vert' denotes a vertical split.+data Dir = Hor+         | Vert+         deriving (Show)++instance Default Dir where+  def = Vert++-- | A Split contains info about a the direction and allocation of a split branch.+data Split = Split+  { _dir :: Dir+  , _splitRule :: SplitRule+  } deriving (Show)+makeLenses ''Split++instance Default Split where+  def = Split def def++-- | A 'View' contains info about a viewport; Whether it's selected and which buffer should be displayed.+data View = View+  { _active :: Bool+  , _bufRef :: BufRef+  } deriving (Show)+makeLenses ''View++-- | A tree of windows branched with splits.+type Window = BiTree Split View++-- | Extension state storing the window layout+data Views = Views+  { _windows' :: Maybe Window+  } deriving (Show)+makeLenses ''Views++-- | A lens to access the stored windows+windows :: HasEditor e => Lens' e (Maybe Window)+windows = ext.windows'++instance Default Views where+  def = Views Nothing++-- | Flip all Horizontal splits to Vertical ones and vice versa.+rotate :: Window -> Window+rotate = cata alg+  where alg (LeafF vw) = Leaf vw+        alg (BranchF sp s e) = Branch (sp & dir %~ rotDir) s e+        rotDir Hor = Vert+        rotDir Vert = Hor++-- | Split active views in the given direction+splitView :: Dir -> Window -> Window+splitView d = cata alg+  where alg (LeafF vw) = if vw ^. active+                            then Branch (Split d def) (Leaf vw) (Leaf (vw & active .~ False))+                            else Leaf vw+        alg b = embed b++-- | Split active views horizontally+hSplit :: Window -> Window+hSplit = splitView Hor++-- | Split active views vertically+vSplit :: Window -> Window+vSplit = splitView Vert++-- | Add a new split at the top level in the given direction containing the given buffer.+addSplit :: Dir -> BufRef -> Window -> Window+addSplit d bRef = Branch (def & dir .~ d) (Leaf $ View False bRef)++-- | Close any views which match a given predicate+closeBy :: (View -> Bool) -> Window -> Maybe Window+closeBy p = zygo par alg+  where+    par (LeafF vw) = not $ p vw+    par (BranchF _ l r) = l || r+    alg (LeafF vw) = Just $ Leaf vw+    alg (BranchF sp (keepLeft, l) (keepRight, r))+      | keepLeft && keepRight = Branch sp <$> l <*> r+      | keepLeft = l+      | keepRight = r+      | otherwise = Nothing++-- | Move focus from any viewports one viewport to the left+focusViewLeft :: Window -> Window+focusViewLeft = ensureOneActive . zygo par alg+  where+    par (LeafF vw) = vw^.active+    par (BranchF (Split Hor _) l r) = l || r+    par (BranchF (Split Vert _) l _) = l+    alg (LeafF vw) = Leaf (vw & active .~ False)+    alg (BranchF sp@(Split Hor _) (_, l) (_, r)) = Branch sp l r+    alg (BranchF sp@(Split Vert _) (_, l) (fromRight, r)) =+      Branch sp left r+        where left = if fromRight+                        then l & taking 1 (backwards traverse) . active .~ True+                        else l++-- | Move focus from any viewports one viewport to the right+focusViewRight :: Window -> Window+focusViewRight = ensureOneActive . zygo par alg+  where+    par (LeafF vw) = vw^.active+    par (BranchF (Split Hor _) l r) = l || r+    par (BranchF (Split Vert _) _ r) = r+    alg (LeafF vw) = Leaf (vw & active .~ False)+    alg (BranchF sp@(Split Hor _) (_, l) (_, r)) = Branch sp l r+    alg (BranchF sp@(Split Vert _) (fromLeft, l) (_, r)) =+      Branch sp l right+        where right = if fromLeft+                         then r & taking 1 traverse . active .~ True+                         else r++-- | Move focus from any viewports one viewport above+focusViewAbove :: Window -> Window+focusViewAbove = ensureOneActive . zygo par alg+  where+    par (LeafF vw) = vw^.active+    par (BranchF (Split Vert _) u d) = u || d+    par (BranchF (Split Hor _) u _) = u+    alg (LeafF vw) = Leaf (vw & active .~ False)+    alg (BranchF sp@(Split Vert _) (_, u) (_, d)) = Branch sp u d+    alg (BranchF sp@(Split Hor _) (_, u) (fromBottom, d)) =+      Branch sp top d+        where top = if fromBottom+                        then u & taking 1 (backwards traverse) . active .~ True+                        else u++-- | Move focus from any viewports one viewport below+focusViewBelow :: Window -> Window+focusViewBelow = ensureOneActive . zygo par alg+  where+    par (LeafF vw) = vw^.active+    par (BranchF (Split Vert _) u d) = u || d+    par (BranchF (Split Hor _) _ d) = d+    alg (LeafF vw) = Leaf (vw & active .~ False)+    alg (BranchF sp@(Split Vert _) (_, u) (_, d)) = Branch sp u d+    alg (BranchF sp@(Split Hor _) (fromTop, u) (_, d)) =+      Branch sp u bottom+        where bottom = if fromTop+                         then d & taking 1 traverse . active .~ True+                         else d++-- | Ensure that there is at least one active viewport+ensureOneActive :: Window -> Window+ensureOneActive w = if not $ anyOf traverse _active w+                       then w & taking 1 traverse . active .~ True+                       else w++-- | Retrieve Views.+getViews :: Action Views+getViews = use ext++-- | Retrieve a tree populated with views and their associated buffer+getBufferViews :: Action (Maybe (BiTree Split (View, Buffer)))+getBufferViews = do+  Views mWin <- getViews+  case mWin of+    Nothing -> return Nothing+    Just win -> sequence <$> mapM collect win+  where+    collect vw = do+      buf <- bufDo (vw^.bufRef) get+      return $ (,) vw <$> buf