{-# LANGUAGE TemplateHaskell #-}
module Vgrep.Widget.HorizontalSplit.Internal (
    -- * Split-view widget state
      HSplit (..)
    , Layout (..)
    , Focus (..)

    -- ** Auto-generated lenses
    , leftWidget
    , rightWidget
    , layout

    -- ** Additional lenses
    , currentWidget
    , leftWidgetFocused
    , rightWidgetFocused

    -- ** Re-exports
    , (%)
    ) where

import Control.Lens.Compat
import Data.Ratio          ((%))


-- $setup
-- >>> :set -fno-warn-missing-fields

-- | The internal state of the split-view widget. Tracks the state of both
-- child widgets and the current layout.
data HSplit s t = HSplit
    { HSplit s t -> s
_leftWidget  :: s
    -- ^ State of the left widget

    , HSplit s t -> t
_rightWidget :: t
    -- ^ State of the right widget

    , HSplit s t -> Layout
_layout      :: Layout
    -- ^ Current layout
    }

data Focus = FocusLeft | FocusRight deriving (Focus -> Focus -> Bool
(Focus -> Focus -> Bool) -> (Focus -> Focus -> Bool) -> Eq Focus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Focus -> Focus -> Bool
$c/= :: Focus -> Focus -> Bool
== :: Focus -> Focus -> Bool
$c== :: Focus -> Focus -> Bool
Eq)
data Layout = LeftOnly | RightOnly | Split Focus Rational deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq)

makeLenses ''HSplit


-- | The currently focused child widget
--
-- >>> view currentWidget $ HSplit { _leftWidget = "foo", _layout = LeftOnly }
-- Left "foo"
currentWidget :: Lens' (HSplit s t) (Either s t)
currentWidget :: (Either s t -> f (Either s t)) -> HSplit s t -> f (HSplit s t)
currentWidget = (HSplit s t -> Either s t)
-> (HSplit s t -> Either s t -> HSplit s t)
-> Lens (HSplit s t) (HSplit s t) (Either s t) (Either s t)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HSplit s t -> Either s t
forall s b. HSplit s b -> Either s b
getCurrentWidget HSplit s t -> Either s t -> HSplit s t
forall s t. HSplit s t -> Either s t -> HSplit s t
setCurrentWidget
  where
    getCurrentWidget :: HSplit s b -> Either s b
getCurrentWidget HSplit s b
state = case Getting Layout (HSplit s b) Layout -> HSplit s b -> Layout
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Layout (HSplit s b) Layout
forall s t. Lens' (HSplit s t) Layout
layout HSplit s b
state of
        Layout
LeftOnly           -> s -> Either s b
forall a b. a -> Either a b
Left  (Getting s (HSplit s b) s -> HSplit s b -> s
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting s (HSplit s b) s
forall s t s. Lens (HSplit s t) (HSplit s t) s s
leftWidget  HSplit s b
state)
        Split Focus
FocusLeft Rational
_  -> s -> Either s b
forall a b. a -> Either a b
Left  (Getting s (HSplit s b) s -> HSplit s b -> s
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting s (HSplit s b) s
forall s t s. Lens (HSplit s t) (HSplit s t) s s
leftWidget  HSplit s b
state)
        Layout
RightOnly          -> b -> Either s b
forall a b. b -> Either a b
Right (Getting b (HSplit s b) b -> HSplit s b -> b
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting b (HSplit s b) b
forall s t t. Lens (HSplit s t) (HSplit s t) t t
rightWidget HSplit s b
state)
        Split Focus
FocusRight Rational
_ -> b -> Either s b
forall a b. b -> Either a b
Right (Getting b (HSplit s b) b -> HSplit s b -> b
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting b (HSplit s b) b
forall s t t. Lens (HSplit s t) (HSplit s t) t t
rightWidget HSplit s b
state)

    setCurrentWidget :: HSplit s t -> Either s t -> HSplit s t
setCurrentWidget HSplit s t
state Either s t
newWidget = case (Getting Layout (HSplit s t) Layout -> HSplit s t -> Layout
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout HSplit s t
state, Either s t
newWidget) of
        (Layout
RightOnly,          Left  s
widgetL) -> ASetter (HSplit s t) (HSplit s t) s s
-> s -> HSplit s t -> HSplit s t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (HSplit s t) (HSplit s t) s s
forall s t s. Lens (HSplit s t) (HSplit s t) s s
leftWidget  s
widgetL HSplit s t
state
        (Split Focus
FocusLeft Rational
_,  Left  s
widgetL) -> ASetter (HSplit s t) (HSplit s t) s s
-> s -> HSplit s t -> HSplit s t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (HSplit s t) (HSplit s t) s s
forall s t s. Lens (HSplit s t) (HSplit s t) s s
leftWidget  s
widgetL HSplit s t
state
        (Layout
LeftOnly,           Right t
widgetR) -> ASetter (HSplit s t) (HSplit s t) t t
-> t -> HSplit s t -> HSplit s t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (HSplit s t) (HSplit s t) t t
forall s t t. Lens (HSplit s t) (HSplit s t) t t
rightWidget t
widgetR HSplit s t
state
        (Split Focus
FocusRight Rational
_, Right t
widgetR) -> ASetter (HSplit s t) (HSplit s t) t t
-> t -> HSplit s t -> HSplit s t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (HSplit s t) (HSplit s t) t t
forall s t t. Lens (HSplit s t) (HSplit s t) t t
rightWidget t
widgetR HSplit s t
state
        (Layout
_,                  Either s t
_            ) -> HSplit s t
state

-- | Traverses the left widget if focused
--
-- >>> has leftWidgetFocused $ HSplit { _layout = LeftOnly }
-- True
--
-- >>> has leftWidgetFocused $ HSplit { _layout = RightOnly }
-- False
--
-- >>> has leftWidgetFocused $ HSplit { _layout = Split FocusLeft (1 % 2) }
-- True
leftWidgetFocused :: Traversal' (HSplit s t) s
leftWidgetFocused :: (s -> f s) -> HSplit s t -> f (HSplit s t)
leftWidgetFocused = (Either s t -> f (Either s t)) -> HSplit s t -> f (HSplit s t)
forall s t. Lens' (HSplit s t) (Either s t)
currentWidget ((Either s t -> f (Either s t)) -> HSplit s t -> f (HSplit s t))
-> ((s -> f s) -> Either s t -> f (Either s t))
-> (s -> f s)
-> HSplit s t
-> f (HSplit s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> f s) -> Either s t -> f (Either s t)
forall a b a'. Traversal (Either a b) (Either a' b) a a'
_Left

-- | Traverses the right widget if focused
--
-- >>> has rightWidgetFocused $ HSplit { _layout = RightOnly }
-- True
--
-- >>> has rightWidgetFocused $ HSplit { _layout = LeftOnly }
-- False
--
-- >>> has rightWidgetFocused $ HSplit { _layout = Split FocusRight (1 % 2) }
-- True
rightWidgetFocused :: Traversal' (HSplit s t) t
rightWidgetFocused :: (t -> f t) -> HSplit s t -> f (HSplit s t)
rightWidgetFocused = (Either s t -> f (Either s t)) -> HSplit s t -> f (HSplit s t)
forall s t. Lens' (HSplit s t) (Either s t)
currentWidget ((Either s t -> f (Either s t)) -> HSplit s t -> f (HSplit s t))
-> ((t -> f t) -> Either s t -> f (Either s t))
-> (t -> f t)
-> HSplit s t
-> f (HSplit s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> f t) -> Either s t -> f (Either s t)
forall a b b'. Traversal (Either a b) (Either a b') b b'
_Right