{-# 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