module Rasa.Ext.Views.Internal.Views
( rotate
, splitRule
, active
, viewable
, scrollPos
, closeBy
, focusViewLeft
, focusViewRight
, focusViewAbove
, focusViewBelow
, getViews
, setViews
, overWindows
, hSplit
, vSplit
, addSplit
, scrollBy
, Dir(..)
, SplitRule(..)
, Window
, Split(..)
, View(..)
, Viewable(..)
, _BufViewRef
, traverseViews
) where
import Rasa.Ext
import Rasa.Ext.Views.Internal.BiTree
import Control.Lens
import Data.Default
import Data.Functor.Foldable
data SplitRule =
Ratio Double
| FromStart Int
| FromEnd Int
deriving (Show)
instance Default SplitRule where
def = Ratio 0.5
data Dir = Hor
| Vert
deriving (Show)
instance Default Dir where
def = Vert
data Split = Split
{ _dir :: Dir
, _splitRule :: SplitRule
} deriving (Show)
makeLenses ''Split
instance Default Split where
def = Split def def
data Viewable =
BufView BufRef
| EmptyView
instance Renderable Viewable where
render _ height scrollPos (BufView br) = bufDo br $ do
txt <- getText
styles <- getStyles
return $ cropToViewport height scrollPos (RenderInfo txt styles)
render _ _ _ EmptyView = return Nothing
_BufViewRef :: Prism' Viewable BufRef
_BufViewRef = prism' BufView maybeBufRef
where maybeBufRef (BufView br) = Just br
maybeBufRef _ = Nothing
data View = View
{ _active :: Bool
, _viewable :: Viewable
, _scrollPos :: Int
}
makeLenses ''View
type Window = BiTree Split View
data Views where
Views :: Maybe Window -> Views
instance Show Views where
show _ = "Views"
instance Default Views where
def = Views Nothing
getViews :: App (Maybe Window)
getViews = do
Views mWin <- use stateLens
return mWin
setViews :: Maybe Window -> App ()
setViews v = stateLens .= Views v
overWindows :: (Window -> Window) -> App ()
overWindows f = do
Views mWin <- use stateLens
stateLens .= (Views $ fmap f mWin)
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
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
hSplit :: Window -> Window
hSplit = splitView Hor
vSplit :: Window -> Window
vSplit = splitView Vert
addSplit :: Dir -> Viewable -> Window -> Window
addSplit d vw = Branch (def & dir .~ d) (Leaf View{_active=False, _viewable=vw, _scrollPos=0})
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
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
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
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
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
ensureOneActive :: Window -> Window
ensureOneActive w = if not $ anyOf traverse _active w
then w & taking 1 traverse . active .~ True
else w
scrollBy :: Int -> Window -> Window
scrollBy amt = traverse.filtered (view active).scrollPos %~ scroll
where
scroll = max 0 . (+ amt)
traverseViews :: (View -> App View) -> App ()
traverseViews f = do
mWin <- getViews
mResult <- sequence $ traverse f <$> mWin
setViews mResult