-- | A split-view widget that displays two widgets side-by-side.
module Vgrep.Widget.HorizontalSplit (
    -- * Horizontal split view widget
      hSplitWidget
    , HSplitWidget

    -- ** Widget state
    , HSplit ()
    , Focus (..)

    -- ** Widget actions
    , leftOnly
    , rightOnly
    , splitView
    , switchFocus

    -- ** Lenses
    , leftWidget
    , rightWidget
    , currentWidget
    , leftWidgetFocused
    , rightWidgetFocused
    ) where

import Control.Applicative (liftA2)
import Control.Lens.Compat
import Graphics.Vty.Image

import Vgrep.Environment
import Vgrep.Event
import Vgrep.Type
import Vgrep.Widget.HorizontalSplit.Internal
import Vgrep.Widget.Type


type HSplitWidget s t = Widget (HSplit s t)

-- | Compose two 'Widget's side-by-side
--
-- * __Initial state__
--
--     Initially, the left widget is rendered full-screen.
--
-- * __Drawing the Widgets__
--
--     Drawing is delegated to the child widgets in a local environment
--     reduced to thir respective 'Viewport'.
hSplitWidget
    :: Widget s
    -> Widget t
    -> HSplitWidget s t
hSplitWidget :: Widget s -> Widget t -> HSplitWidget s t
hSplitWidget Widget s
left Widget t
right = Widget :: forall s.
s
-> (forall (m :: * -> *). Monad m => VgrepT s m Image) -> Widget s
Widget
    { initialize :: HSplit s t
initialize = Widget s -> Widget t -> HSplit s t
forall s t. Widget s -> Widget t -> HSplit s t
initHSplit   Widget s
left Widget t
right
    , draw :: forall (m :: * -> *). Monad m => VgrepT (HSplit s t) m Image
draw       = Widget s -> Widget t -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) s t.
Monad m =>
Widget s -> Widget t -> VgrepT (HSplit s t) m Image
drawWidgets  Widget s
left Widget t
right }

initHSplit :: Widget s -> Widget t -> HSplit s t
initHSplit :: Widget s -> Widget t -> HSplit s t
initHSplit Widget s
left Widget t
right = HSplit :: forall s t. s -> t -> Layout -> HSplit s t
HSplit
    { _leftWidget :: s
_leftWidget  = Widget s -> s
forall s. Widget s -> s
initialize Widget s
left
    , _rightWidget :: t
_rightWidget = Widget t -> t
forall s. Widget s -> s
initialize Widget t
right
    , _layout :: Layout
_layout      = Layout
LeftOnly }


-- | Display the left widget full-screen
leftOnly :: Monad m => VgrepT (HSplit s t) m Redraw
leftOnly :: VgrepT (HSplit s t) m Redraw
leftOnly = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Redraw)
-> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Layout
LeftOnly -> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Unchanged
    Layout
_other   -> ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout Layout
LeftOnly VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw

-- | Display the right widget full-screen
rightOnly :: Monad m => VgrepT (HSplit s t) m Redraw
rightOnly :: VgrepT (HSplit s t) m Redraw
rightOnly = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Redraw)
-> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Layout
RightOnly -> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Unchanged
    Layout
_other    -> ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout Layout
RightOnly VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw

-- | Display both widgets in a split view.
splitView
    :: Monad m
    => Focus -- ^ Focus left or right area
    -> Rational -- ^ Left area width as fraction of overall width
    -> VgrepT (HSplit s t) m Redraw
splitView :: Focus -> Rational -> VgrepT (HSplit s t) m Redraw
splitView Focus
focus Rational
ratio = ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout (Focus -> Rational -> Layout
Split Focus
focus Rational
ratio) VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw

-- | Switch focus from left to right child widget and vice versa (only if
-- the '_layout' is 'Split')
switchFocus :: Monad m => VgrepT (HSplit s t) m Redraw
switchFocus :: VgrepT (HSplit s t) m Redraw
switchFocus = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Redraw)
-> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Split Focus
focus Rational
ratio -> ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout (Focus -> Rational -> Layout
switch Focus
focus Rational
ratio) VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw
    Layout
_otherwise        -> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Unchanged
  where
    switch :: Focus -> Rational -> Layout
switch Focus
FocusLeft  Rational
ratio = Focus -> Rational -> Layout
Split Focus
FocusRight (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
ratio)
    switch Focus
FocusRight Rational
ratio = Focus -> Rational -> Layout
Split Focus
FocusLeft  (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
ratio)

drawWidgets
    :: Monad m
    => Widget s
    -> Widget t
    -> VgrepT (HSplit s t) m Image
drawWidgets :: Widget s -> Widget t -> VgrepT (HSplit s t) m Image
drawWidgets Widget s
left Widget t
right = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Image)
-> VgrepT (HSplit s t) m Image
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Layout
LeftOnly      -> LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
-> VgrepT s m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
forall s t s2. Lens (HSplit s t) (HSplit s2 t) s s2
leftWidget  (Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget s
left)
    Layout
RightOnly     -> LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
-> VgrepT t m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
forall s t t2. Lens (HSplit s t) (HSplit s t2) t t2
rightWidget (Widget t -> forall (m :: * -> *). Monad m => VgrepT t m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget t
right)
    Split Focus
_ Rational
ratio -> (Image -> Image -> Image)
-> VgrepT (HSplit s t) m Image
-> VgrepT (HSplit s t) m Image
-> VgrepT (HSplit s t) m Image
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Image -> Image -> Image
(<|>)
        (Rational -> VgrepT s m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) s t.
Monad m =>
Rational -> VgrepT s m Image -> VgrepT (HSplit s t) m Image
runInLeftWidget  Rational
ratio (Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget s
left))
        (Rational -> VgrepT t m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) t s.
Monad m =>
Rational -> VgrepT t m Image -> VgrepT (HSplit s t) m Image
runInRightWidget Rational
ratio (Widget t -> forall (m :: * -> *). Monad m => VgrepT t m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget t
right))

runInLeftWidget
    :: Monad m
    => Rational
    -> VgrepT s m Image
    -> VgrepT (HSplit s t) m Image
runInLeftWidget :: Rational -> VgrepT s m Image -> VgrepT (HSplit s t) m Image
runInLeftWidget Rational
ratio VgrepT s m Image
action =
    let leftRegion :: Environment -> Environment
leftRegion = ASetter Environment Environment Int Int
-> (Int -> Int) -> Environment -> Environment
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Environment Environment Int Int
Lens' Environment Int
viewportWidth ((Int -> Int) -> Environment -> Environment)
-> (Int -> Int) -> Environment -> Environment
forall a b. (a -> b) -> a -> b
$ \Int
w ->
            Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
ratio Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
    in  LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
-> VgrepT s m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
forall s t s2. Lens (HSplit s t) (HSplit s2 t) s s2
leftWidget ((Environment -> Environment)
-> VgrepT s m Image -> VgrepT s m Image
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Environment -> Environment
leftRegion VgrepT s m Image
action)


runInRightWidget
    :: Monad m
    => Rational
    -> VgrepT t m Image
    -> VgrepT (HSplit s t) m Image
runInRightWidget :: Rational -> VgrepT t m Image -> VgrepT (HSplit s t) m Image
runInRightWidget Rational
ratio VgrepT t m Image
action =
    let rightRegion :: Environment -> Environment
rightRegion = ASetter Environment Environment Int Int
-> (Int -> Int) -> Environment -> Environment
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Environment Environment Int Int
Lens' Environment Int
viewportWidth ((Int -> Int) -> Environment -> Environment)
-> (Int -> Int) -> Environment -> Environment
forall a b. (a -> b) -> a -> b
$ \Int
w ->
            Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
ratio) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
    in  LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
-> VgrepT t m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
forall s t t2. Lens (HSplit s t) (HSplit s t2) t t2
rightWidget ((Environment -> Environment)
-> VgrepT t m Image -> VgrepT t m Image
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Environment -> Environment
rightRegion VgrepT t m Image
action)