{-# LANGUAGE RecordWildCards #-}

module Monomer.EnhancedSlider.UI
    ( buildUI
    , makeTitle
    ) where

import Control.Applicative ((<|>))
import Data.Maybe
import Data.Text (Text)
import Monomer.Core.Combinators
import Monomer.Widgets.Composite
import Monomer.Widgets.Containers.Box
import Monomer.Widgets.Containers.Stack
import Monomer.Widgets.Single
import Monomer.Widgets.Singles.Button
import Monomer.Widgets.Singles.Label
import Monomer.Widgets.Singles.Slider
import qualified Data.Text as T

import Monomer.EnhancedSlider.EnhancedSliderCfg
import Monomer.EnhancedSlider.EnhancedSliderEvent

buildUI
    :: (SliderValue a)
    => (EnhancedSliderCfg s e a)
    -> a
    -> a
    -> UIBuilder a (EnhancedSliderEvent a)
buildUI :: forall a s e.
SliderValue a =>
EnhancedSliderCfg s e a
-> a -> a -> UIBuilder a (EnhancedSliderEvent a)
buildUI config :: EnhancedSliderCfg s e a
config@(EnhancedSliderCfg{[a -> WidgetRequest s e]
[Path -> WidgetRequest s e]
Maybe Bool
Maybe Rational
Maybe Text
Maybe AlignH
Maybe AlignV
Maybe (a -> Text)
_escOnChangeReq :: forall s e a. EnhancedSliderCfg s e a -> [a -> WidgetRequest s e]
_escOnBlurReq :: forall s e a.
EnhancedSliderCfg s e a -> [Path -> WidgetRequest s e]
_escOnFocusReq :: forall s e a.
EnhancedSliderCfg s e a -> [Path -> WidgetRequest s e]
_escAlignV :: forall s e a. EnhancedSliderCfg s e a -> Maybe AlignV
_escAlignH :: forall s e a. EnhancedSliderCfg s e a -> Maybe AlignH
_escTitleMethod :: forall s e a. EnhancedSliderCfg s e a -> Maybe (a -> Text)
_escTitle :: forall s e a. EnhancedSliderCfg s e a -> Maybe Text
_escHideLabel :: forall s e a. EnhancedSliderCfg s e a -> Maybe Bool
_escDragRate :: forall s e a. EnhancedSliderCfg s e a -> Maybe Rational
_escOnChangeReq :: [a -> WidgetRequest s e]
_escOnBlurReq :: [Path -> WidgetRequest s e]
_escOnFocusReq :: [Path -> WidgetRequest s e]
_escAlignV :: Maybe AlignV
_escAlignH :: Maybe AlignH
_escTitleMethod :: Maybe (a -> Text)
_escTitle :: Maybe Text
_escHideLabel :: Maybe Bool
_escDragRate :: Maybe Rational
..}) a
a a
b WidgetEnv a (EnhancedSliderEvent a)
_ a
model = WidgetNode a (EnhancedSliderEvent a)
tree where
    tree :: WidgetNode a (EnhancedSliderEvent a)
tree = if Maybe Bool
_escHideLabel forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True
        then forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
vstack_ [forall t. CmbChildSpacing t => Double -> t
childSpacing_ Double
16]
            [ forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [forall t. CmbAlignLeft t => t
alignLeft] forall a b. (a -> b) -> a -> b
$ forall s e. Text -> WidgetNode s e
label forall a b. (a -> b) -> a -> b
$ forall a s e. SliderValue a => EnhancedSliderCfg s e a -> a -> Text
makeTitle EnhancedSliderCfg s e a
config a
model
            , forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [forall t. CmbAlignLeft t => t
alignLeft] WidgetNode a (EnhancedSliderEvent a)
mainStack
            ]
        else WidgetNode a (EnhancedSliderEvent a)
mainStack
    mainStack :: WidgetNode a (EnhancedSliderEvent a)
mainStack = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe AlignV
_escAlignV
        then forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
hstack_ [forall t. CmbChildSpacing t => Double -> t
childSpacing_ Double
32] [WidgetNode a (EnhancedSliderEvent a)]
arrangementH
        else forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
vstack_ [forall t. CmbChildSpacing t => Double -> t
childSpacing_ Double
24] [WidgetNode a (EnhancedSliderEvent a)]
arrangementV
    arrangementH :: [WidgetNode a (EnhancedSliderEvent a)]
arrangementH = case forall a. a -> Maybe a -> a
fromMaybe AlignH
ALeft Maybe AlignH
_escAlignH of
        AlignH
ALeft -> [WidgetNode a (EnhancedSliderEvent a)
hsliderWidget, WidgetNode a (EnhancedSliderEvent a)
minusButton, WidgetNode a (EnhancedSliderEvent a)
plusButton]
        AlignH
ACenter -> [WidgetNode a (EnhancedSliderEvent a)
minusButton, WidgetNode a (EnhancedSliderEvent a)
hsliderWidget, WidgetNode a (EnhancedSliderEvent a)
plusButton]
        AlignH
ARight -> [WidgetNode a (EnhancedSliderEvent a)
minusButton, WidgetNode a (EnhancedSliderEvent a)
plusButton, WidgetNode a (EnhancedSliderEvent a)
hsliderWidget]
    arrangementV :: [WidgetNode a (EnhancedSliderEvent a)]
arrangementV = case forall a. a -> Maybe a -> a
fromMaybe AlignV
ABottom Maybe AlignV
_escAlignV of
        AlignV
ATop -> [WidgetNode a (EnhancedSliderEvent a)
vsliderWidget, WidgetNode a (EnhancedSliderEvent a)
plusButton, WidgetNode a (EnhancedSliderEvent a)
minusButton]
        AlignV
AMiddle -> [WidgetNode a (EnhancedSliderEvent a)
plusButton, WidgetNode a (EnhancedSliderEvent a)
vsliderWidget, WidgetNode a (EnhancedSliderEvent a)
minusButton]
        AlignV
ABottom -> [WidgetNode a (EnhancedSliderEvent a)
plusButton, WidgetNode a (EnhancedSliderEvent a)
minusButton, WidgetNode a (EnhancedSliderEvent a)
vsliderWidget]
    hsliderWidget :: WidgetNode a (EnhancedSliderEvent a)
hsliderWidget = forall a e s.
(SliderValue a, WidgetEvent e) =>
ALens' s a -> a -> a -> [SliderCfg s e a] -> WidgetNode s e
hslider_ forall a. a -> a
id a
a a
b [SliderCfg a (EnhancedSliderEvent a) a]
sliderConfig
    vsliderWidget :: WidgetNode a (EnhancedSliderEvent a)
vsliderWidget = forall a e s.
(SliderValue a, WidgetEvent e) =>
ALens' s a -> a -> a -> [SliderCfg s e a] -> WidgetNode s e
vslider_ forall a. a -> a
id a
a a
b [SliderCfg a (EnhancedSliderEvent a) a]
sliderConfig
    minusButton :: WidgetNode a (EnhancedSliderEvent a)
minusButton = Text
-> EnhancedSliderEvent a -> WidgetNode a (EnhancedSliderEvent a)
button' Text
"-" forall a b. (a -> b) -> a -> b
$ forall a. a -> EnhancedSliderEvent a
EventSetField forall a b. (a -> b) -> a -> b
$ a
modelforall a. Num a => a -> a -> a
-a
changeRate
    plusButton :: WidgetNode a (EnhancedSliderEvent a)
plusButton = Text
-> EnhancedSliderEvent a -> WidgetNode a (EnhancedSliderEvent a)
button' Text
"+" forall a b. (a -> b) -> a -> b
$ forall a. a -> EnhancedSliderEvent a
EventSetField forall a b. (a -> b) -> a -> b
$ a
modelforall a. Num a => a -> a -> a
+a
changeRate
    sliderConfig :: [SliderCfg a (EnhancedSliderEvent a) a]
sliderConfig =
        [ forall t a. CmbWheelRate t a => a -> t
wheelRate Rational
0
        , forall t a. CmbDragRate t a => a -> t
dragRate forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational a
changeRate
        , forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange forall a. a -> EnhancedSliderEvent a
EventSetField
        , forall t e a. CmbOnFocus t e a => (a -> e) -> t
onFocus forall a. Path -> EnhancedSliderEvent a
EventFocus
        , forall t e a. CmbOnBlur t e a => (a -> e) -> t
onBlur forall a. Path -> EnhancedSliderEvent a
EventBlur
        ]
    button' :: Text
-> EnhancedSliderEvent a -> WidgetNode a (EnhancedSliderEvent a)
button' Text
c EnhancedSliderEvent a
e = forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Text
c EnhancedSliderEvent a
e [ButtonCfg a (EnhancedSliderEvent a)]
buttonConfig forall t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic`
        [ forall t. CmbWidth t => Double -> t
width Double
32
        , forall t. CmbHeight t => Double -> t
height Double
24
        ]
    buttonConfig :: [ButtonCfg a (EnhancedSliderEvent a)]
buttonConfig =
        [ forall t e a. CmbOnFocus t e a => (a -> e) -> t
onFocus forall a. Path -> EnhancedSliderEvent a
EventFocus
        , forall t e a. CmbOnBlur t e a => (a -> e) -> t
onBlur forall a. Path -> EnhancedSliderEvent a
EventBlur
        ]
    changeRate :: a
changeRate = forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Rational
1 Maybe Rational
_escDragRate

makeTitle
    :: (SliderValue a)
    => (EnhancedSliderCfg s e a)
    -> a
    -> Text
makeTitle :: forall a s e. SliderValue a => EnhancedSliderCfg s e a -> a -> Text
makeTitle EnhancedSliderCfg{[a -> WidgetRequest s e]
[Path -> WidgetRequest s e]
Maybe Bool
Maybe Rational
Maybe Text
Maybe AlignH
Maybe AlignV
Maybe (a -> Text)
_escOnChangeReq :: [a -> WidgetRequest s e]
_escOnBlurReq :: [Path -> WidgetRequest s e]
_escOnFocusReq :: [Path -> WidgetRequest s e]
_escAlignV :: Maybe AlignV
_escAlignH :: Maybe AlignH
_escTitleMethod :: Maybe (a -> Text)
_escTitle :: Maybe Text
_escHideLabel :: Maybe Bool
_escDragRate :: Maybe Rational
_escOnChangeReq :: forall s e a. EnhancedSliderCfg s e a -> [a -> WidgetRequest s e]
_escOnBlurReq :: forall s e a.
EnhancedSliderCfg s e a -> [Path -> WidgetRequest s e]
_escOnFocusReq :: forall s e a.
EnhancedSliderCfg s e a -> [Path -> WidgetRequest s e]
_escAlignV :: forall s e a. EnhancedSliderCfg s e a -> Maybe AlignV
_escAlignH :: forall s e a. EnhancedSliderCfg s e a -> Maybe AlignH
_escTitleMethod :: forall s e a. EnhancedSliderCfg s e a -> Maybe (a -> Text)
_escTitle :: forall s e a. EnhancedSliderCfg s e a -> Maybe Text
_escHideLabel :: forall s e a. EnhancedSliderCfg s e a -> Maybe Bool
_escDragRate :: forall s e a. EnhancedSliderCfg s e a -> Maybe Rational
..} a
value = Text
result where
    result :: Text
result = forall a. a -> Maybe a -> a
fromMaybe Text
showValue forall a b. (a -> b) -> a -> b
$ Maybe Text
withMethod forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
titleValue
    withMethod :: Maybe Text
withMethod = (forall a b. (a -> b) -> a -> b
$ a
value) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> Text)
_escTitleMethod
    titleValue :: Maybe Text
titleValue = (forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
showValue) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_escTitle
    showValue :: Text
showValue = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
value