HFitUI (empty) → 0.1.0.0

raw patch · 32 files changed

+4776/−0 lines, 32 filesdep +HFitUIdep +MissingHdep +basesetup-changed

Dependencies added: HFitUI, MissingH, base, blaze-html, blaze-markup, mtl, process, random, shakespeare, template-haskell, text, uuid

Files

HFitUI.cabal +102/−0
LICENSE +30/−0
README.md +112/−0
Setup.hs +2/−0
app/Main.hs +18/−0
src/WebUI/Demo/LibDemo.hs +80/−0
src/WebUI/HFitUI.hs +23/−0
src/WebUI/Layouts/LayoutBase.hs +236/−0
src/WebUI/Scripts/HScript.hs +113/−0
src/WebUI/Scripts/JavaScript/HJSBuilder.hs +69/−0
src/WebUI/Scripts/JavaScript/HJSElementDOM.hs +42/−0
src/WebUI/Scripts/JavaScript/HJSExps.hs +54/−0
src/WebUI/Scripts/JavaScript/HJSFunction.hs +128/−0
src/WebUI/Scripts/JavaScript/HJSKeywords.hs +30/−0
src/WebUI/Scripts/JavaScript/HJSMath.hs +99/−0
src/WebUI/Scripts/JavaScript/HJSTypes.hs +281/−0
src/WebUI/Scripts/JavaScript/HJSUtils.hs +124/−0
src/WebUI/Scripts/JavaScript/HJSVars.hs +172/−0
src/WebUI/Scripts/JavaScript/HJavaScript.hs +83/−0
src/WebUI/Scripts/UIAction.hs +53/−0
src/WebUI/Themes/SolarizedUITheme.hs +83/−0
src/WebUI/Themes/UITheme.hs +15/−0
src/WebUI/Themes/UIThemeTypes.hs +65/−0
src/WebUI/Themes/UIThemeUtils.hs +85/−0
src/WebUI/Widgets/Components/UIBase.hs +306/−0
src/WebUI/Widgets/Extensions/BootStrapExtension.hs +105/−0
src/WebUI/Widgets/Extensions/JQueryExtension.hs +42/−0
src/WebUI/Widgets/Extensions/MapOSMExtension.hs +46/−0
src/WebUI/Widgets/Extensions/ToolTipExtension.hs +117/−0
src/WebUI/Widgets/Kits/UIKits.hs +28/−0
src/WebUI/Widgets/UIWidget.hs +2031/−0
test/Spec.hs +2/−0

+ HFitUI.cabal view

@@ -0,0 +1,102 @@+name:                HFitUI+version:             0.1.0.0+synopsis:            The library for generating a graphical interface on the web+description:         The library for generating a graphical interface on the web for the Haskell programming language.+homepage:            https://github.com/iqsf/HFitUI.git+license:             BSD3+license-file:        LICENSE+author:              Pavel+maintainer:          iqsf@ya.ru+copyright:           2017 QSpider+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     WebUI.HFitUI++                     , WebUI.Layouts.LayoutBase++                     , WebUI.Themes.UITheme+                     , WebUI.Themes.UIThemeTypes+                     , WebUI.Themes.UIThemeUtils+                     , WebUI.Themes.SolarizedUITheme++                     , WebUI.Widgets.UIWidget+                     , WebUI.Widgets.Kits.UIKits+                     , WebUI.Widgets.Components.UIBase++                     , WebUI.Scripts.HScript+                     , WebUI.Scripts.UIAction+                     , WebUI.Scripts.JavaScript.HJavaScript+                     , WebUI.Scripts.JavaScript.HJSKeywords+                     , WebUI.Scripts.JavaScript.HJSTypes+                     , WebUI.Scripts.JavaScript.HJSBuilder+                     , WebUI.Scripts.JavaScript.HJSUtils+                     , WebUI.Scripts.JavaScript.HJSVars+                     , WebUI.Scripts.JavaScript.HJSExps+                     , WebUI.Scripts.JavaScript.HJSMath+                     , WebUI.Scripts.JavaScript.HJSFunction+                     , WebUI.Scripts.JavaScript.HJSElementDOM++                     , WebUI.Widgets.Extensions.ToolTipExtension+                     , WebUI.Widgets.Extensions.BootStrapExtension+                     , WebUI.Widgets.Extensions.MapOSMExtension+                     , WebUI.Widgets.Extensions.JQueryExtension++                     , WebUI.Demo.LibDemo++  default-extensions:  DataKinds+                       DeriveDataTypeable+                       DeriveGeneric+                       CPP+                       MultiParamTypeClasses+                       FlexibleInstances+                       TemplateHaskell+                       TypeOperators+                       TypeFamilies+                       QuasiQuotes+                       OverloadedStrings+                       FlexibleContexts+                       GADTs+                       RankNTypes+                       FunctionalDependencies+                       GeneralizedNewtypeDeriving+                       UndecidableInstances++  build-depends:       base >= 4.7 && < 5+                     , blaze-html                >= 0.8.1+                     , blaze-markup              >= 0.7.1+                     , mtl                       >= 2.2.1+                     , MissingH                  >= 1.4.0+                     , process                   >= 1.4.2 +                     , random                    >= 1.1+                     , shakespeare               >= 2.0.11+                     , template-haskell          >= 2.11.0+                     , text                      >= 1.2.2+                     , uuid                      >= 1.3.12++  default-language:    Haskell2010++executable HFitUI-exe+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , HFitUI+  default-language:    Haskell2010++test-suite HFitUI-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , HFitUI+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/iqsf/HFitUI

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,112 @@+# HFitUI++## Introduction+Library for generating a graphical interface on the web for the Haskell programming language.++## Short description+The **HFitUI** uses the blaze library as the result of generating a graphical interface on the web. Using the HFitUI, you construct an interface from the panels, buttons, more complex widget components.The HFitUI has its own Javascript generator from Haskell code based on a set of JavaScript simulation functions.+Below is an example [demo](https://github.com/iqsf/HFitUI/blob/master/src/WebUI/Demo/LibDemo.hs) code:++```+testOne :: UI H.Html+testOne = +    widgetLayoutUI $ do +        -- Базовые виджеты+        shell                   <- shellExtUI "TestGL (Dyn)" []+        (root, idRoot, _)       <- expandWUI $ wuiPanel <#> boundsBRDNum (44, 0, 0, 0)+                                                        <#> overflowHiddenX+                                                        <#> overflowAutoY++        scriptsOutside          <- wuiScriptSrc [] ++        jsScript                <- wuiScriptTextJS $ runScript defaultHBConfig {hbc_entryLine = "\n"+                                                                               } $ do +                                        var_b <- newVarInt "b" 10 +                                        var_c <- newVarInt "c" 5+                                        var_cm <- newVar "cm" $ mathACos var_c+                                        (//) "Test variable"+                                        var_testPer <- newVar "testPer" HJsEmpty+                                        var_st <- newVarStr "st" "TestSt"+                                        flag_1 <- newVarBool "flag_1" True+                                        var_res <- newVar "res" HJsNull++                                        var_res <- eql var_res $ (var_b + var_c) * var_st / var_b+                                        var_res <- eql var_res var_b ++                                        hjs $(juliusFile "templates/test/TestScript.julius") ++                                        hjs $[julius|    +                                            function veryTest (){+                                                console.log("VeryTest");+                                            }+                                        |]++                                        (***) $ "The first multi-line comment" +-+ +                                                "before the myFunc function"+                                        vatFn_myFunc <- functJS "myFunc" [] $ do +                                            return endH+                                        call vatFn_myFunc []+                                        var_res_myFunc <- eqlMT (varJS "res_myFunc") $ call vatFn_myFunc []++                                        var_testFunc <- eqlMT (varJS "testFunc") $ functJS "" [] $ do +                                            var_bbb <- newVarInt "bbb" 23 +                                            returnJS thisJS+                                        call var_testFunc []+                                        var_res_testFunc <- eqlMT (varJS "res_testFunc") $ call var_testFunc [5, var_b, valStr "qwe", valInt 19, valBool True]+                                        var_res_new_testFunc <- eqlMT (varJS "res_new_testFunc") $ newJS $ call var_testFunc [5, var_b, valStr "qwe", valInt 19, valBool True]++                                        jsFinish ++        shell `addWUIs` [ root+                        , scriptsOutside+                        , jsScript+                        ]+```++This code generates the following HTML:++```+<!DOCTYPE HTML>+<html><head><title>TestGL (Dyn)</title></head><body id="f98b3765-f949-44ed-b653-7234e250f08e" ui_widget="shell" style=""><div id="42826f90-aa08-4008-b3a7-3c27e62b5d2d" ui_widget="panel" style="top:44px;right:0px;bottom:0px;left:0px;overflow-x: hidden;overflow-y: auto;" class=""></div><script type="text/javascript" id="87a1f750-123a-4148-bcb5-a53f40e23a52" ui_widget="script_text" style="" class="">+/*Generate by HScript from the HFitUI library*/+var b = 10;+var c = 5;+var cm = Math.acos(c);+//Test variable+var testPer;+var st = "TestSt";+var flag_1 = true;+var res = null;+res = (((b + c) * st) / b);+res = b;+function test(){+    console.log("Test");+}+function veryTest (){+    console.log("VeryTest");+}+/*The first multi-line comment+before the myFunc function*/+function myFunc (){+}+myFunc();+res_myFunc = myFunc();+;+testFunc = function (){+  var bbb = 23;+  return this;+}+;+testFunc();+res_testFunc = testFunc(5, b, "qwe", 19, true);+;+res_new_testFunc = new testFunc(5, b, "qwe", 19, true);++;+</script></body></html>+```++The library **HFitUI** represents a simple yet powerful tool for creating graphical interface on the Web.+++

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,18 @@+--------------------------------------------------------------+-- Главный модуль программы (Main)+----------------------------------------------------------------++module Main where++-- Импорт модулей+import           WebUI.Demo.LibDemo++++-- | Точка входа в программу+main :: IO ()+--main = return ()+main = testDemo+++

+ src/WebUI/Demo/LibDemo.hs view

@@ -0,0 +1,80 @@+--------------------------------------------------------------+-- Module for demonstrating the work of the library+----------------------------------------------------------------++module WebUI.Demo.LibDemo +    ( testDemo+    ) where++-- Импорт модулей+import qualified Text.Blaze.Html5                            as H++import           Text.Hamlet+import           Text.Julius++import           WebUI.HFitUI+import           WebUI.Scripts.JavaScript.HJavaScript+import           WebUI.Themes.SolarizedUITheme+++-- | Demo test+testDemo :: IO ()+testDemo = do+    res <- testOne+    putStrLn $ show res++++testOne :: UI H.Html+testOne = +    widgetLayoutUI $ do +        -- Базовые виджеты+        shell                   <- shellExtUI "TestGL (Dyn)" []+        (root, idRoot, _)       <- expandWUI $ wuiPanel <#> boundsBRDNum (44, 0, 0, 0)+                                                        <#> overflowHiddenX+                                                        <#> overflowAutoY++        scriptsOutside          <- wuiScriptSrc [] ++        jsScript                <- wuiScriptTextJS $ runScript defaultHBConfig {hbc_entryLine = "\n"+                                                                               } $ do +                                        var_b <- newVarInt "b" 10 +                                        var_c <- newVarInt "c" 5+                                        var_cm <- newVar "cm" $ mathACos var_c+                                        (//) "Test variable"+                                        var_testPer <- newVar "testPer" HJsEmpty+                                        var_st <- newVarStr "st" "TestSt"+                                        flag_1 <- newVarBool "flag_1" True+                                        var_res <- newVar "res" HJsNull++                                        var_res <- eql var_res $ (var_b + var_c) * var_st / var_b+                                        var_res <- eql var_res var_b ++                                        hjs $(juliusFile "templates/test/TestScript.julius") ++                                        hjs $[julius|    +                                            function veryTest (){+                                                console.log("VeryTest");+                                            }+                                        |]++                                        (***) $ "The first multi-line comment" +-+ +                                                "before the myFunc function"+                                        vatFn_myFunc <- functJS "myFunc" [] $ do +                                            return endH+                                        call vatFn_myFunc []+                                        var_res_myFunc <- eqlMT (varJS "res_myFunc") $ call vatFn_myFunc []++                                        var_testFunc <- eqlMT (varJS "testFunc") $ functJS "" [] $ do +                                            var_bbb <- newVarInt "bbb" 23 +                                            returnJS thisJS+                                        call var_testFunc []+                                        var_res_testFunc <- eqlMT (varJS "res_testFunc") $ call var_testFunc [5, var_b, valStr "qwe", valInt 19, valBool True]+                                        var_res_new_testFunc <- eqlMT (varJS "res_new_testFunc") $ newJS $ call var_testFunc [5, var_b, valStr "qwe", valInt 19, valBool True]++                                        jsFinish ++        shell `addWUIs` [ root+                        , scriptsOutside+                        , jsScript+                        ]

+ src/WebUI/HFitUI.hs view

@@ -0,0 +1,23 @@+----------------------------------------------------------------+-- Модуль общего импорта графического интерфейса (HFitUI)+----------------------------------------------------------------++module WebUI.HFitUI+    ( module HFitUI+    ) where++++-- Импорт модулей+import           WebUI.Layouts.LayoutBase         as HFitUI+import           WebUI.Widgets.UIWidget           as HFitUI+import           WebUI.Widgets.Kits.UIKits        as HFitUI++import           WebUI.Themes.UITheme             as HFitUI+import           WebUI.Themes.UIThemeTypes        as HFitUI++import           WebUI.Widgets.Components.UIBase  as HFitUI++import           WebUI.Scripts.HScript            as HFitUI +import           WebUI.Scripts.UIAction           as HFitUI+

+ src/WebUI/Layouts/LayoutBase.hs view

@@ -0,0 +1,236 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Базовые менеджеры рвзмещения +----------------------------------------------------------------++module WebUI.Layouts.LayoutBase+    ( simpleLayoutUI++    , baseLayoutUI+    , baseLayoutUI_2++    , widgetLayoutUI+    , widgetUnsafeLayoutUI+    ) where++-- Импорт модулей+import           Prelude                         as PRL+import           Language.Haskell.TH.Syntax++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Widgets.UIWidget++++-- | Подготовка CSS+prepareCSS a = toHtml $ renderCssUrl undefined a+++-- | Подготовка JavaScript+prepareJS b = toHtml $ renderJavascriptUrl undefined b++++----------------------------------------------------------------------------------------------+-- SimpleLayout   ----------------------------------------------------------------------------+----------------------------------------------------------------------------------------------++-- | Простой менеджер размещения UI+-- Формирует страницу согласно размещению+simpleLayoutUI :: H.Html  -- ^ Содержимое для HEAD раздела страницы+               -> H.Html  -- ^ Содержимое для BODY раздела страницы+               -> H.Html  -- ^ Результирующая страница+simpleLayoutUI headContent +               bodyContent = H.docTypeHtml $ do+    H.head $ do+        headContent+    H.body $ do+        bodyContent++++----------------------------------------------------------------------------------------------+-- BaseLayout   ------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------++-- | Базовый менеджер размещения UI+-- Формирует страницу согласно размещению+baseLayoutUI :: H.Html             -- ^ Заголовок страницы+             -> [CssUrl a]         -- ^ Массив стилей для HEAD раздела страницы+             -> [JavascriptUrl b]  -- ^ Массив скриптов для HEAD раздела страницы+             -> [H.Html]           -- ^ Массив содержимого для BODY раздела страницы+             -> H.Html             -- ^ Результирующая страница+baseLayoutUI titleText +             headStyleArray +             jsArray  +             bodyContentArray = H.docTypeHtml $ do+    H.head $ do+        H.title titleText+        H.style $ do +            mapM_ prepareCSS headStyleArray+        H.script ! src "/jquery.js" $ ""+        H.script ! src "/md5.js" $ ""+        H.script ! type_ "text/javascript" $ do+            mapM_ prepareJS jsArray+    H.body $ do+        mapM_ toHtml bodyContentArray++++-- | Базовый менеджер размещения UI V_2+-- Формирует страницу согласно размещению+baseLayoutUI_2 :: H.Html             -- ^ Заголовок страницы+               -> [CssUrl a]         -- ^ Массив стилей для HEAD раздела страницы+               -> [JavascriptUrl b]  -- ^ Массив скриптов для HEAD раздела страницы+               -> [H.Html]           -- ^ Массив содержимого для BODY раздела страницы+               -> H.Html             -- ^ Результирующая страница+baseLayoutUI_2 titleText +               headStyleArray +               jsArray  +               bodyContentArray = H.docTypeHtml $ do+    H.head $ do+        H.title titleText+        H.script ! src "/jquery.js" $ ""+        H.script ! src "/md5.js" $ ""+        H.link ! rel "stylesheet" ! type_ "text/css" ! href "/ol.css" +        H.script ! src "/ol.js" $ ""+        H.script ! type_ "text/javascript" $ do+            mapM_ prepareJS jsArray+        H.style $ do +            mapM_ prepareCSS headStyleArray+    H.body $ do+        mapM_ toHtml bodyContentArray++++----------------------------------------------------------------------------------------------+-- WidgetLayout   ----------------------------------------------------------------------------+----------------------------------------------------------------------------------------------++-- | Менеджер размещения UI+-- Формирует страницу из виджетов+widgetLayoutUI :: UI WidgetUI        -- ^ Виджет UI+               -> UI H.Html          -- ^ Результирующая страница+widgetLayoutUI w = do +    widget   <- w +    styles   <- return $ wui_styles   widget +    scripts  <- return $ wui_scripts  widget +    contents <- return $ wui_contents widget +    return $ H.docTypeHtml $ do+        H.head $ do+            H.title $ wui_title widget +            mapM_ (H.toHtml) (stylesWidgetUI  widget)+            mapM_ (H.toHtml) (scriptsWidgetUI widget)+            mapM_ (! type_ "text/javascript") scripts+        H.body ! HA.id (toAttrVal $ wui_id widget) +               ! TBI.customAttribute "ui_widget" (toAttrVal . wui_ui_name $ widget)+               ! HA.style (toAttrVal . wui_attr_style $ widget) +               $ do+            mapM_ toHtml contents+            mapM_ buildWidgetUI (wui_children widget)+    where+        stylesWidgetUI :: WidgetUI -> [H.Html]+        stylesWidgetUI wui = (wui_styles wui) ++ (recStylesChildrenUI (wui_children wui))++        recStylesChildrenUI :: [WidgetUI] -> [H.Html]+        recStylesChildrenUI [] = []+        recStylesChildrenUI (x:xs)  = (stylesWidgetUI x) ++ (recStylesChildrenUI xs)+++        scriptsWidgetUI :: WidgetUI -> [H.Html]+        scriptsWidgetUI wui = (wui_scripts wui) ++ (recScriptsChildrenUI (wui_children wui))++        recScriptsChildrenUI :: [WidgetUI] -> [H.Html]+        recScriptsChildrenUI [] = []+        recScriptsChildrenUI (x:xs)  = (scriptsWidgetUI x) ++ (recScriptsChildrenUI xs)+++        -- Построение виджетов UI содержимого страницы+        buildWidgetUI :: WidgetUI -> H.Html+        buildWidgetUI wui = case (wui_element . packWidgetUI $ wui) of+            ContainerUI f   -> recursiveChildrenUI f (wui_children wui)+            ElementUI e     -> e+            EmptyElementUI  -> recursiveChildrenUI toHtml (wui_children wui)++        -- Рекурсивный обход для построение виджетов UI содержимого страницы+        recursiveChildrenUI :: (H.Html -> H.Html) -> [WidgetUI] -> H.Html+        recursiveChildrenUI ff []    = ff ""+        recursiveChildrenUI ff array = ff $ do mapM_ buildWidgetUI array++++-- | Менеджер размещения UI (Unsafe)+-- Формирует страницу из виджетов+widgetUnsafeLayoutUI :: UI WidgetUI        -- ^ Виджет UI+                     -> H.Html             -- ^ Результирующая страница+{-# DEPRECATED widgetUnsafeLayoutUI "This is unsafe! It is not recommended to use this function!" #-}+widgetUnsafeLayoutUI w = +    H.docTypeHtml $ do+        H.head $ do+            H.title $ wui_title widget +            --H.style $ do +            --    mapM_ H.toHtml styles+            --H.script ! type_ "text/javascript" $ do+            --    mapM_ H.toHtml scripts+            --mapM_  (H.toHtml) styles+            mapM_ (H.toHtml) (stylesWidgetUI  widget)+            mapM_ (H.toHtml) (scriptsWidgetUI widget)+            mapM_ (! type_ "text/javascript") scripts+        H.body ! HA.id (toAttrVal $ wui_id widget) +               ! TBI.customAttribute "ui_widget" (toAttrVal . wui_ui_name $ widget)+               ! HA.style (toAttrVal . wui_attr_style $ widget) +               $ do+        --H.body $ do+            mapM_ toHtml contents+            mapM_ buildWidgetUI (wui_children widget)+    where+        widget = unsafePerformUI w ++        styles   = wui_styles   widget +        scripts  = wui_scripts  widget +        contents = wui_contents widget ++        +        stylesWidgetUI :: WidgetUI -> [H.Html]+        stylesWidgetUI wui = (wui_styles wui) ++ (recStylesChildrenUI (wui_children wui))++        recStylesChildrenUI :: [WidgetUI] -> [H.Html]+        recStylesChildrenUI [] = []+        recStylesChildrenUI (x:xs)  = (stylesWidgetUI x) ++ (recStylesChildrenUI xs)+++        scriptsWidgetUI :: WidgetUI -> [H.Html]+        scriptsWidgetUI wui = (wui_scripts wui) ++ (recScriptsChildrenUI (wui_children wui))++        recScriptsChildrenUI :: [WidgetUI] -> [H.Html]+        recScriptsChildrenUI [] = []+        recScriptsChildrenUI (x:xs)  = (scriptsWidgetUI x) ++ (recScriptsChildrenUI xs)+++        -- Построение виджетов UI содержимого страницы+        buildWidgetUI :: WidgetUI -> H.Html+        buildWidgetUI wui = case (wui_element . packWidgetUI $ wui) of+            ContainerUI f   -> recursiveChildrenUI f (wui_children wui)+            ElementUI e     -> e+            EmptyElementUI  -> recursiveChildrenUI toHtml (wui_children wui)++        -- Рекурсивный обход для построение виджетов UI содержимого страницы+        recursiveChildrenUI :: (H.Html -> H.Html) -> [WidgetUI] -> H.Html+        recursiveChildrenUI ff []    = ff ""+        recursiveChildrenUI ff array = ff $ do mapM_ buildWidgetUI array+++

+ src/WebUI/Scripts/HScript.hs view

@@ -0,0 +1,113 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Действия +----------------------------------------------------------------++module WebUI.Scripts.HScript+    ( module ConMonRWS+    , HSL (..)+     +    , TypeHLang  (..)+    , HLanguage  (..)++    , BuilderHSL (..)++    , HBConfig   (..), defaultHBConfig+    , HBLog      (..)++    , HLFinish   (..)++    , runScript+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Control.Monad.RWS                           as ConMonRWS+import           System.IO.Unsafe                               (unsafePerformIO)++++-- | Тип монадного трансформера для HScript+-- Формат для RWST монады: RWST r w s m a+type HSL l a = RWST HBConfig [HBLog] l IO a       +++-- | Тип языка+data TypeHLang = THLScript +               | THLBinary +               | THLOther String+               deriving (Show, Eq)++++-- | Данные конфигурации билдера скрипта+data HBConfig = HBConfig { hbc_titleComment :: String   -- ^ Комментарий в заголовке кода скрипта +                         , hbc_entryLine    :: String   -- ^ Разделитель строк+                         , hbc_tabSpace     :: String   -- ^ Строка табуляции (если пуста, то код будет без табуляции)+                         , hbc_empty        :: String   -- ^ Пустой символ+                         }++-- | Данные конфигурации билдера скрипта+defaultHBConfig :: HBConfig+defaultHBConfig = HBConfig { hbc_titleComment = "Generate by HScript from the HFitUI library" +                           , hbc_entryLine    = ""+                           , hbc_tabSpace     = "  "+                           , hbc_empty        = ""+                           }+++-- | Данные лога билдера скрипта+data HBLog = HBLog String++++-- | Класс скриптового языка+class HLanguage a where+    nameHLang  :: a -> String+    typeHLang  :: a -> TypeHLang+    initHLang  :: a +    emptyHLang :: a+    beginH     :: a+    endH       :: a++++-- | Класс билдера скриптов+class BuilderHSL a where+    buildHSL :: HBConfig -> a -> String+    buildHSL hbConf _ = hbc_empty hbConf++    buildHSL_L :: HBConfig -> a -> String+    buildHSL_L _ _ = error "HScript Error! There was a call method \'buildHSL_L\' from class \'BuilderHSL\' for unintended type."++    buildHSL_R :: HBConfig -> a -> String+    buildHSL_R _ _ = error "HScript Error! There was a call method \'buildHSL_R\' from class \'BuilderHSL\' for unintended type."++++-- | Данные завершения скрипта        +data HLFinish = HLFinish++instance BuilderHSL HLFinish where+    buildHSL   _ _ = ""+    buildHSL_L _ _ = ""+    buildHSL_R _ _ = ""+                            ++++-- | Запустить скрипт на его генерацию+runScript :: (HLanguage l, BuilderHSL l, BuilderHSL a) +          => HBConfig+          -> HSL l a+          -> String+runScript hbConf srcHSL =  +    unsafePerformIO $ do+        (s, log) <- execRWST srcHSL hbConf initHLang+        return $ buildHSL hbConf s ++++

+ src/WebUI/Scripts/JavaScript/HJSBuilder.hs view

@@ -0,0 +1,69 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Билдер для языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSBuilder+    () where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+--import           Data.String.Utils                              (strip)+import qualified Data.Text.Lazy                              as DTL++import           WebUI.Scripts.HScript++++instance BuilderHSL Int where+    buildHSL hbConf v = show v +    buildHSL_L = buildHSL+    buildHSL_R = buildHSL+++instance BuilderHSL Integer where+    buildHSL hbConf v = show v +    buildHSL_L = buildHSL+    buildHSL_R = buildHSL+++instance BuilderHSL Rational where+    buildHSL hbConf v = show v +    buildHSL_L = buildHSL+    buildHSL_R = buildHSL+++instance BuilderHSL Double where+    buildHSL hbConf v = show v+    buildHSL_L = buildHSL+    buildHSL_R = buildHSL++++instance BuilderHSL Bool where+    buildHSL hbConf v = strBool v+        where+            lwr       = map toLower+            strBool f = lwr $ show f+    buildHSL_L = buildHSL+    buildHSL_R = buildHSL++++instance BuilderHSL String where+    buildHSL hbConf v = v +    buildHSL_L = buildHSL+    buildHSL_R = buildHSL++++instance BuilderHSL DTL.Text where+    buildHSL hbConf v = DTL.unpack v +    buildHSL_L = buildHSL+    buildHSL_R = buildHSL+++

+ src/WebUI/Scripts/JavaScript/HJSElementDOM.hs view

@@ -0,0 +1,42 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Переменные для Языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSElementDOM+    ( getElementById +    , addEventListener+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSTypes++++-- | Виджет скрипта JS+getElementById :: String +               -> HLangJS +getElementById eid =  +    HL $ "document.getElementById(\"" ++ eid ++ "\")"++++-- Добавляем слушателя+addEventListener :: (BuilderHSL l) +                 => String+                 -> l+                 -> Bool +                 -> HSL HLangJS HLangJS +addEventListener tp listener flag = do+    c <- ask+    hl <- return $ HL $ "window.addEventListener( \'" ++ tp ++ "\'," ++ (buildHSL_L c listener) ++ ","  ++ (buildHSL c flag) ++ " );" ++ (hbc_entryLine c)+    modify (:> hl)+    return hl+

+ src/WebUI/Scripts/JavaScript/HJSExps.hs view

@@ -0,0 +1,54 @@+{-# LANGUAGE ScopedTypeVariables #-}+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Выражения для языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSExps+    (-- HJsExp (..)++    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSBuilder+import           WebUI.Scripts.JavaScript.HJSTypes+import           WebUI.Scripts.JavaScript.HJSVars++++hbConf = defaultHBConfig++++instance PRL.Num HLangJS where+    (HL x) + (HL y) = HL $ "(" ++ (buildHSL_L hbConf x) ++ " + " ++ (buildHSL_L hbConf y) ++ ")"+    _ + _ = error "HScript Error! Could not math operation \'+\' from class Num for HLangJS."++    (HL x) - (HL y) = HL $ "(" ++ (buildHSL_L hbConf x) ++ " - " ++ (buildHSL_L hbConf y) ++ ")"+    _ - _ = error "HScript Error! Could not math operation \'-\' from class Num for HLangJS."++    (HL x) * (HL y) = HL $ "(" ++ (buildHSL_L hbConf x) ++ " * " ++ (buildHSL_L hbConf y) ++ ")"+    _ * _ = error "HScript Error! Could not math operation \'*\' from class Num for HLangJS."++    negate      x = HL $ "((-1)*"     ++ (buildHSL_L hbConf x) ++ ")" +    abs         x = HL $ "Math.abs("  ++ (buildHSL_L hbConf x) ++ ")"+    signum      x = HL $ "Math.sign(" ++ (buildHSL_L hbConf x) ++ ")"+    fromInteger x = HL $ x ++++instance PRL.Fractional HLangJS where+    (HL x) / (HL y) = HL $ "(" ++ (buildHSL_L hbConf x) ++ " / " ++ (buildHSL_L hbConf y) ++ ")"+    _ / _ = error "HScript Error! Could not math operation \'/\' from class Num for HLangJS."+     +    fromRational x = HL $ buildHSL_L hbConf x+++

+ src/WebUI/Scripts/JavaScript/HJSFunction.hs view

@@ -0,0 +1,128 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Функции языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSFunction+    ( HJsFunc   (..), functJS+    , HJsCall   (..), call+    , HJsNew    (..), newJS+    , HJsReturn (..), returnJS+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSTypes+import           WebUI.Scripts.JavaScript.HJSBuilder+import           WebUI.Scripts.JavaScript.HJSUtils              (smartTabStr)++++-- | Функция+data HJsFunc = forall f. (BuilderHSL f) => HJsFunc JsName [HLangJS] f+++instance BuilderHSL HJsFunc where+    buildHSL hbConf (HJsFunc n args f) = +        let nf = if (length n) == 0 then "" else n ++ " " in+        "function " ++ nf ++ "(" ++ "){" ++ (hbc_entryLine hbConf) +++        (smartTabStr (buildHSL hbConf f) (hbc_tabSpace hbConf)) +++        "}" ++ (hbc_entryLine hbConf)++    buildHSL_L hbConf (HJsFunc n _ _) = n+    buildHSL_R hbConf (HJsFunc _ _ f) = buildHSL hbConf f++++-- | Новая функция+functJS :: JsName+        -> [HLangJS] +        -> HSL HLangJS HLangJS +        -> HSL HLangJS HLangJS+functJS name args fnHSL = do+    hbConf <- ask +    s <- liftIO $ do (_, s, _) <- runRWST fnHSL hbConf HLangJS+                     return s+    fnc <- return $ HL $ HJsFunc name args s+    modify (:> fnc)+    return fnc++++-- | Функция+data HJsCall = forall f a. (BuilderHSL f) => HJsCall f [HLangJS] ++instance BuilderHSL HJsCall where+    buildHSL hbConf (HJsCall f args) = +        (buildHSL_L hbConf f) ++ "(" ++ (buildHSL_L hbConf args) ++ ")" ++ ";" ++ (hbc_entryLine hbConf)++    buildHSL_L hbConf (HJsCall f _   ) = buildHSL_L hbConf f+    buildHSL_R hbConf (HJsCall _ args) = buildHSL_R hbConf args++++-- | Вызвать функцию+call :: (BuilderHSL f) +     => f+     -> [HLangJS]+     -> HSL HLangJS HLangJS+call f args = do+    clf <- return $ HL $ HJsCall f args+    modify (:> clf)+    return clf ++++-- | Синтаксис New+data HJsNew = forall n. (BuilderHSL n) => HJsNew n+++instance BuilderHSL HJsNew where+    buildHSL hbConf (HJsNew n) = +        "new " ++ (buildHSL hbConf n) ++ (hbc_entryLine hbConf)++    buildHSL_L hbConf (HJsNew  _) = "new "++++-- | Новый синтаксис New+newJS :: HSL HLangJS HLangJS +      -> HSL HLangJS HLangJS+newJS newHSL = do+    hbConf <- ask +    s <- liftIO $ do (_, s, _) <- runRWST newHSL hbConf HLangJS+                     return s+    rn <- return $ HL $ HJsNew s+    modify (:> rn)+    return rn++++-- | Синтаксис Return+data HJsReturn = forall r. (BuilderHSL r) => HJsReturn r+++instance BuilderHSL HJsReturn where+    buildHSL hbConf (HJsReturn r) = +        "return " ++ (buildHSL hbConf r) ++ ";" ++ (hbc_entryLine hbConf)++    buildHSL_L hbConf (HJsReturn  _) = "return "++++-- | Новый синтаксис Return+returnJS :: HLangJS +         -> HSL HLangJS HLangJS+returnJS ret = do+    rr <- return $ HL $ HJsReturn ret+    modify (:> rr)+    return HLangJS+++

+ src/WebUI/Scripts/JavaScript/HJSKeywords.hs view

@@ -0,0 +1,30 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Ключевые слова для языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSKeywords+    ( jsCom, jsComS, jsComF+    , jsFunc+    ) where++-- Импорт модулей+++jsCom :: String+jsCom = "//"++jsComS :: String+jsComS = "/*"++jsComF :: String+jsComF = "*/"++++jsFunc :: String+jsFunc = "function"+++

+ src/WebUI/Scripts/JavaScript/HJSMath.hs view

@@ -0,0 +1,99 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Математические операции для языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSMath+    ( mathAbs+    , mathACos+    , mathACosh  +    , mathASin   +    , mathASinh  +    , mathAtan   +    , mathAtan2  +    , mathAtanh  +    , mathCbrt   +    , mathCeil   +    , mathClz32  +    , mathCos    +    , mathCosH   +    , mathExp    +    , mathExpm1  +    , mathFloor  +    , mathFround +    , mathHypot  +    , mathImul   +    , mathLog    +    , mathLog10  +    , mathLog1p  +    , mathLog2   +    , mathMax    +    , mathMin    +    , mathPow    +    , mathRandom +    , mathRound  +    , mathSign   +    , mathSin    +    , mathSinh   +    , mathSqrt   +    , mathTan    +    , mathTanh   +    , mathTrunc  +    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSTypes+import           WebUI.Scripts.JavaScript.HJSBuilder++    ++hbConf = defaultHBConfig++++mathAbs = abs++mathACos   x = HL $ "Math.acos("    ++ (buildHSL_L hbConf x) ++ ")"+mathACosh  x = HL $ "Math.acosh()"  ++ (buildHSL_L hbConf x) ++ ")"+mathASin   x = HL $ "Math.asin()"   ++ (buildHSL_L hbConf x) ++ ")"+mathASinh  x = HL $ "Math.asinh()"  ++ (buildHSL_L hbConf x) ++ ")"+mathAtan   x = HL $ "Math.atan()"   ++ (buildHSL_L hbConf x) ++ ")"+mathAtan2  x = HL $ "Math.atan2()"  ++ (buildHSL_L hbConf x) ++ ")"+mathAtanh  x = HL $ "Math.atanh()"  ++ (buildHSL_L hbConf x) ++ ")"+mathCbrt   x = HL $ "Math.cbrt()"   ++ (buildHSL_L hbConf x) ++ ")"+mathCeil   x = HL $ "Math.ceil()"   ++ (buildHSL_L hbConf x) ++ ")"+mathClz32  x = HL $ "Math.clz32()"  ++ (buildHSL_L hbConf x) ++ ")"+mathCos    x = HL $ "Math.cos()"    ++ (buildHSL_L hbConf x) ++ ")"+mathCosH   x = HL $ "Math.cosh()"   ++ (buildHSL_L hbConf x) ++ ")"+mathExp    x = HL $ "Math.exp()"    ++ (buildHSL_L hbConf x) ++ ")"+mathExpm1  x = HL $ "Math.expm1()"  ++ (buildHSL_L hbConf x) ++ ")"+mathFloor  x = HL $ "Math.floor()"  ++ (buildHSL_L hbConf x) ++ ")"+mathFround x = HL $ "Math.fround()" ++ (buildHSL_L hbConf x) ++ ")"+mathHypot  x = HL $ "Math.hypot()"  ++ (buildHSL_L hbConf x) ++ ")"+mathImul   x = HL $ "Math.imul()"   ++ (buildHSL_L hbConf x) ++ ")"+mathLog    x = HL $ "Math.log()"    ++ (buildHSL_L hbConf x) ++ ")"+mathLog10  x = HL $ "Math.log10()"  ++ (buildHSL_L hbConf x) ++ ")"+mathLog1p  x = HL $ "Math.log1p()"  ++ (buildHSL_L hbConf x) ++ ")"+mathLog2   x = HL $ "Math.log2()"   ++ (buildHSL_L hbConf x) ++ ")"+mathMax    x = HL $ "Math.max()"    ++ (buildHSL_L hbConf x) ++ ")"+mathMin    x = HL $ "Math.min()"    ++ (buildHSL_L hbConf x) ++ ")"+mathPow    x = HL $ "Math.pow()"    ++ (buildHSL_L hbConf x) ++ ")"+mathRandom x = HL $ "Math.random()" ++ (buildHSL_L hbConf x) ++ ")" +mathRound  x = HL $ "Math.round()"  ++ (buildHSL_L hbConf x) ++ ")"+mathSign   x = HL $ "Math.sign()"   ++ (buildHSL_L hbConf x) ++ ")" +mathSin    x = HL $ "Math.sin()"    ++ (buildHSL_L hbConf x) ++ ")"+mathSinh   x = HL $ "Math.sinh()"   ++ (buildHSL_L hbConf x) ++ ")" +mathSqrt   x = HL $ "Math.sqrt()"   ++ (buildHSL_L hbConf x) ++ ")"  +mathTan    x = HL $ "Math.tan()"    ++ (buildHSL_L hbConf x) ++ ")" +mathTanh   x = HL $ "Math.tanh()"   ++ (buildHSL_L hbConf x) ++ ")"  +mathTrunc  x = HL $ "Math.trunc()"  ++ (buildHSL_L hbConf x) ++ ")"   +++

+ src/WebUI/Scripts/JavaScript/HJSTypes.hs view

@@ -0,0 +1,281 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Типы для Языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSTypes+    ( HLangJS           (..)+    , JsName            (..)+    , HJsTitle          (..)++    , HJsEmpty          (..)++    , HJsBegin          (..)+    , HJsEnd            (..)++    , HJsNull           (..)+    , HJsUndefined      (..)+    +    , HJsThis           (..), thisJS++    , HComment          (..), commentJS     , (//)+    , HCommentMultiLine (..), commentMLineJS, (***)++    , (+-+)++    , hl+    , hJS++    , valInt, valInteger, valRational, valDouble+    , valBool+    , valStr, valText+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)+import qualified Data.Text.Lazy                              as DTL++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSBuilder+import           WebUI.Scripts.JavaScript.HJSKeywords++++----------------------------------------------------------------+-- Основа синтаксисиа языка   ----------------------------------+----------------------------------------------------------------++-- | Корневой тип для JavaScript+data HLangJS = forall a b. (BuilderHSL a, BuilderHSL b) => a :> b+             | forall c.   (BuilderHSL c              ) => HL c+             | HLangJS++++-- | Реализуем класс скриптового языка для корневого типа JavaScript+instance HLanguage HLangJS where+    nameHLang _ = "JavaScript"+    typeHLang _ = THLScript+    initHLang   = (HJsTitle :> HJsEmpty)+    emptyHLang  = HL $ HJsEmpty+    beginH      = HL $ HJsBegin+    endH        = HL $ HJsEnd++++-- | Реализуем класс билдера скриптов для HLangJS+instance BuilderHSL HLangJS where+    buildHSL hbConf (a :> b) = +        buildHSL hbConf a +++        buildHSL hbConf b +    buildHSL hbConf (HL c) = buildHSL hbConf c+    buildHSL _ HLangJS = ""++    buildHSL_L hbConf (a :> b) =+        buildHSL_L hbConf a +++        buildHSL_L hbConf b +    buildHSL_L hbConf (HL c) = buildHSL_L hbConf c+    buildHSL_L _ HLangJS = ""++    buildHSL_R hbConf (a :> b) =+        buildHSL_R hbConf a +++        buildHSL_R hbConf b +    buildHSL_R hbConf (HL c) = buildHSL_R hbConf c+    buildHSL_R _ HLangJS = ""++++-- | Реализуем класс билдера скриптов для HLangJS+instance BuilderHSL [HLangJS] where+    buildHSL _      []     = ""+    buildHSL hbConf (x:xs) = +        let bXS = (buildHSL hbConf xs) in+        (buildHSL hbConf x) ++ (if bXS == "" then "" else ", ") ++ bXS++    buildHSL_L _      []     = ""+    buildHSL_L hbConf (x:xs) = +        let bXS = (buildHSL_L hbConf xs) in+        (buildHSL_L hbConf x) ++ (if bXS == "" then "" else ", ") ++ bXS++    buildHSL_R _      []     = ""+    buildHSL_R hbConf (x:xs) = +        let bXS = (buildHSL_R hbConf xs) in+        (buildHSL_R hbConf x) ++ (if bXS == "" then "" else ", ") ++ bXS++++-- | Имена в JS+type JsName = String++++-- | Заголовок скрипта+data HJsTitle = HJsTitle++-- | Реализуем класс билдера скриптов для HJsTitle+instance BuilderHSL HJsTitle where+    buildHSL hbConf _ = +        hbc_entryLine hbConf ++ +        if length hTC > 0 then jsComS ++ hTC ++ jsComF ++ hEL else ""+        where+            hEL = hbc_entryLine hbConf  +            hTC = strip . hbc_titleComment $ hbConf++++-- | Пустота+data HJsEmpty = HJsEmpty++instance BuilderHSL HJsEmpty where+    buildHSL _ _ = ""++++-- | Условное начало+data HJsBegin = HJsBegin++instance BuilderHSL HJsBegin where+    buildHSL _ _ = ""++++-- | Условное окончание+data HJsEnd = HJsEnd++instance BuilderHSL HJsEnd where+    buildHSL _ _ = ""++++-- | Комментарий однострочный+data HComment = HComment String++instance BuilderHSL HComment where+    buildHSL hbConf (HComment v) = "//" ++ v ++ "\n"++commentJS :: String +          -> HSL HLangJS ()+commentJS text = do+    cmn <- return $ HL $ HComment text+    modify (:> cmn)+    return ()++(//) = commentJS++++-- | Комментарий многострочный+data HCommentMultiLine = HCommentMultiLine String++instance BuilderHSL HCommentMultiLine where+    buildHSL hbConf (HCommentMultiLine v) = "/*" ++ v ++ "*/" ++ (hbc_entryLine hbConf)++commentMLineJS :: String +               -> HSL HLangJS ()+commentMLineJS text = do+    cmn <- return $ HL $ HCommentMultiLine text+    modify (:> cmn)+    return ()++(***) = commentMLineJS+++(+-+) p1 p2 = p1 ++ "\n" ++ p2+++-- | Значение Null+data HJsNull = HJsNull++instance BuilderHSL HJsNull where+    buildHSL _ _ = "null"++++-- | Значение Undefined+data HJsUndefined = HJsUndefined++instance BuilderHSL HJsUndefined where+    buildHSL _ _ = "undefined"++++-- | Значение This+data HJsThis = HJsThis++instance BuilderHSL HJsThis where+    buildHSL _ _ = "this"+++-- | Создать синтаксис This+thisJS :: HLangJS+thisJS = hl HJsThis++++-- | Обернуть тип в HLangJS+hl :: (BuilderHSL a) +   => a +   -> HLangJS+hl p = HL $ p++++-- | Обернуть строку как JavaScript код+hJS :: String+    -> HLangJS+hJS = hl++++----------------------------------------------------------------+-- Значения   --------------------------------------------------++-- | Значение Int+valInt :: Int+       -> HLangJS+valInt = hl+++-- | Значение Integer+valInteger :: Integer+           -> HLangJS+valInteger = hl+++-- | Значение Rational+valRational :: Rational+            -> HLangJS+valRational = hl+++-- | Значение Double+valDouble :: Double+          -> HLangJS+valDouble = hl++++-- | Значение Bool+valBool :: Bool+        -> HLangJS+valBool = hl++++-- | Значение String+valStr :: String+       -> HLangJS+valStr txt = hl $ show txt+++-- | Значение Text+valText :: DTL.Text+        -> HLangJS+valText txt = hl $ show txt+++

+ src/WebUI/Scripts/JavaScript/HJSUtils.hs view

@@ -0,0 +1,124 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Утилиты генератора языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSUtils+    ( smartTrim, smartTrimStr+    , smartTab , smartTabStr+    , ujs+    , upjs+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           System.IO.Unsafe                               (unsafePerformIO)++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import qualified Data.Text.Lazy                              as DTL+import           Data.Int++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSTypes+import           WebUI.Scripts.JavaScript.HJSBuilder+++++-- | Умная обрезка текста кода после Julius (String)+smartTrimStr :: String +             -> String+smartTrimStr txt = DTL.unpack $ smartTrim $ DTL.pack txt++++-- | Умная обрезка текста кода после Julius+smartTrim :: DTL.Text +          -> DTL.Text+smartTrim txt = +    let linesTxt = DTL.lines txt in+    DTL.unlines $ dropWhole linesTxt $ findCount linesTxt maxCounter+    where +        findCount :: [DTL.Text] -> Int64 -> Int64+        findCount (x:xs) counter = let len = lenSP x counter in +                                   if len < counter +                                   then findCount xs len +                                   else findCount xs counter+        findCount []     counter = if counter == maxCounter +                                   then 0 +                                   else counter++        maxCounter :: Int64+        maxCounter = 1000000  ++        lenSP :: DTL.Text -> Int64 -> Int64+        lenSP txt counter = let res = lenSP_ txt counter in if res < 0+                                                            then 0+                                                            else res+ +        lenSP_ :: DTL.Text -> Int64 -> Int64+        lenSP_ txt counter = if (DTL.length txt) == 0 || (DTL.length txt) == (DTL.length $ DTL.takeWhile (==' ') txt)+                             then counter+                             else  DTL.length $ DTL.takeWhile (==' ') txt++        dropWhole :: [DTL.Text] -> Int64 -> [DTL.Text]+        dropWhole (x:xs) count = if (DTL.length x) > count +                                 then (DTL.drop count x):(dropWhole xs count)+                                 else (dropWhole xs count)+        dropWhole []     _     = [] ++++++-- | Умная табуляция кода (String)+smartTabStr :: String+            -> String+            -> String+smartTabStr txt tab = DTL.unpack $ smartTab (DTL.pack txt) (DTL.pack tab)+++ +-- | Умная табуляция кода+smartTab :: DTL.Text +         -> DTL.Text+         -> DTL.Text+smartTab txt tab = +    let linesTxt = DTL.lines txt in+    DTL.unlines $ tabWhole linesTxt $ tab+    where +        tabWhole :: [DTL.Text] -> DTL.Text -> [DTL.Text]+        tabWhole (x:xs) tb = if (DTL.length x) > 0 +                             then (DTL.append tb x):(tabWhole xs tb)+                             else x:(tabWhole xs tb)+        tabWhole []     _  = [] +++-- | Распаковать значение из монадгного трансформера с конфигурацией +-- по умолчанию и пустым исходным состоянияем+ujs :: HSL HLangJS HLangJS+    -> HLangJS+ujs srcHSL =  +    unsafePerformIO $ do+        (a, s, log) <- runRWST srcHSL defaultHBConfig HLangJS+        return a ++++-- | Распаковать значение из монадгного трансформера с конфигурацией +-- по умолчанию и пустым исходным состоянияем+upjs :: HSL HLangJS HLangJS+     -> HBConfig+     -> HLangJS+     -> HLangJS+upjs srcHSL hbConf st =  +    unsafePerformIO $ do+        (a, s, log) <- runRWST srcHSL hbConf st+        return a+++

+ src/WebUI/Scripts/JavaScript/HJSVars.hs view

@@ -0,0 +1,172 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Переменные для Языка JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJSVars+    ( HJsEql (..)+    , eqlNew, eqlNewMT+    , eql   , eqlMT++    , HJsVar (..), varJS++    , newVar+    , newVarInt+    , newVarDouble+    , newVarBool+    , newVarStr+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSUtils              (upjs)+import           WebUI.Scripts.JavaScript.HJSTypes+import           WebUI.Scripts.JavaScript.HJSBuilder++++-- | Данные связи переменных+data HJsEql = forall n v. (BuilderHSL n, BuilderHSL v) => HJsEqlNew n v+            | forall n v. (BuilderHSL n, BuilderHSL v) => HJsEql    n v++instance BuilderHSL HJsEql where+    buildHSL hbConf (HJsEqlNew n v) = +        "var " ++ (buildHSL hbConf $ HJsEql n v)+    buildHSL hbConf (HJsEql n v) = +        let value = valEql hbConf v in+        (nameEql hbConf n value) ++ value ++ ";" ++ (hbc_entryLine hbConf)+        where+            nameEql hbConf n v = +                let res = (buildHSL hbConf n) in+                if PRL.length res == 0+                then error ("HScript Error! There is no name for HJsEql value: (" ++ v ++ ")")+                else res+            valEql hbConf v = +                let res = (buildHSL hbConf v) in+                if PRL.length res == 0+                then ""+                else " = " ++ res++    buildHSL_L hbConf (HJsEqlNew n _) = buildHSL_L hbConf n+    buildHSL_L hbConf (HJsEql    n _) = buildHSL_L hbConf n++    buildHSL_R hbConf (HJsEqlNew _ v) = buildHSL_R hbConf v+    buildHSL_R hbConf (HJsEql    _ v) = buildHSL_R hbConf v++++-- | Новая связь создаваемых переменных+eqlNew :: (BuilderHSL n, BuilderHSL v) +       => n+       -> v +       -> HSL HLangJS HLangJS+eqlNew name val = do +    var <- return $ HL $ HJsEqlNew name val+    modify (:> var)+    return $ HL name++++-- | Новая связь создаваемых переменных через монадный трансформер+eqlNewMT :: (BuilderHSL n) +         => n+         -> HSL HLangJS HLangJS+         -> HSL HLangJS HLangJS+eqlNewMT name val = do +    c <- ask+    s <- get+    var <- return $ HL $ HJsEqlNew name $ upjs val c s+    modify (:> var)+    return $ HL name++++-- | Новая связь переменных+eql :: (BuilderHSL n, BuilderHSL v) +    => n+    -> v +    -> HSL HLangJS HLangJS+eql name val = do +    var <- return $ HL $ HJsEql name val+    modify (:> var)+    return $ HL name++++-- | Новая связь переменных через монадный трансформер+eqlMT :: (BuilderHSL n) +      => n+      -> HSL HLangJS HLangJS +      -> HSL HLangJS HLangJS+eqlMT name val = do +    c <- ask+    s <- get+    var <- return $ HL $ HJsEql name $ upjs val c s+    modify (:> var)+    return $ HL name++++-- | Данные имени связи переменных+data HJsVar = forall k. (BuilderHSL k) => HJsVar k++instance BuilderHSL HJsVar where+    buildHSL   hbConf (HJsVar k) = buildHSL   hbConf k+    buildHSL_L hbConf (HJsVar k) = buildHSL_L hbConf k+    buildHSL_R hbConf (HJsVar k) = error ("HScript Error! Calling function \'buildHSL_R\' for (" ++ (buildHSL hbConf k) ++ ")" )++-- | Имя переменной+varJS :: JsName+      -> HJsVar+varJS name = HJsVar name++++-- | Новая переменная+newVar :: (BuilderHSL v) +       => JsName+       -> v+       -> HSL HLangJS HLangJS +newVar name val = eqlNew (varJS name) val+++++-- | Новая переменная Int+newVarInt :: JsName+          -> Int+          -> HSL HLangJS HLangJS+newVarInt name val = eqlNew (varJS name) val++++-- | Новая переменная Double+newVarDouble :: JsName+             -> Double+             -> HSL HLangJS HLangJS+newVarDouble name val = eqlNew (varJS name) val++++-- | Новая переменная Bool+newVarBool :: JsName+           -> Bool+           -> HSL HLangJS HLangJS+newVarBool name val = eqlNew (varJS name) val++++-- | Новая переменная String+newVarStr :: JsName+          -> String+          -> HSL HLangJS HLangJS+newVarStr name val = eqlNew (varJS name) (show val)+++

+ src/WebUI/Scripts/JavaScript/HJavaScript.hs view

@@ -0,0 +1,83 @@+----------------------------------------------------------------+-- Модуль приложения+-- Скрипты графического интерфейса (HScript)+-- Язык JavaScript +----------------------------------------------------------------++module WebUI.Scripts.JavaScript.HJavaScript+    ( module HJavaScriptBuilder+    , module HJavaScriptTypes+    , module HJavaScriptVars+    , module HJavaScriptExps+    , module HJavaScriptMath+    , module HJavaScriptFunction+    , module HJavaScriptElementDOM+    , hjs+    , ujs+    , upjs+    , hjsBR+    , jsFinish+    ) where++-- Импорт модулей+import           Prelude                                     as PRL++import           Data.Char                                      (toLower)+import           Data.String.Utils                              (strip)++import qualified Data.Text.Lazy                              as DTL+import           Data.Int++import           Control.Monad.RWS                           as ConMonRWS++import           System.IO.Unsafe                               (unsafePerformIO)++import           Text.Blaze.Html5                ++import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Scripts.HScript+import           WebUI.Scripts.JavaScript.HJSUtils              (smartTrim, ujs, upjs)+import           WebUI.Scripts.JavaScript.HJSBuilder         as HJavaScriptBuilder+import           WebUI.Scripts.JavaScript.HJSTypes           as HJavaScriptTypes+import           WebUI.Scripts.JavaScript.HJSVars            as HJavaScriptVars+import           WebUI.Scripts.JavaScript.HJSExps            as HJavaScriptExps+import           WebUI.Scripts.JavaScript.HJSMath            as HJavaScriptMath+import           WebUI.Scripts.JavaScript.HJSFunction        as HJavaScriptFunction+import           WebUI.Scripts.JavaScript.HJSElementDOM      as HJavaScriptElementDOM++++-- | Подготовка JavaScript+prepareJS b = renderJavascriptUrl undefined b++++-- | Виджет скрипта JS+hjs :: JavascriptUrl b +    -> HSL HLangJS HLangJS +hjs js = do +    hl <- return $ HL $ smartTrim $ do prepareJS js+    modify (:> hl)+    return hl++++-- | Детектор WebGL+hjsBR :: HSL HLangJS HLangJS +hjsBR = do  +    c <- ask+    hl <- return $ HL $ " " ++ (hbc_entryLine c)+    modify (:> hl)+    return hl+++jsFinish :: HSL HLangJS HLFinish+jsFinish = do+    return HLFinish+++

+ src/WebUI/Scripts/UIAction.hs view

@@ -0,0 +1,53 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Действия +----------------------------------------------------------------++module WebUI.Scripts.UIAction+    ( onClick   , onClick_+    , onRedirect, onRedirect_+    ) where++-- Импорт модулей+import           Prelude                         as PRL++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           WebUI.Widgets.UIWidget+import           WebUI.Themes.SolarizedUITheme    ++++----------------------------------------------------------------+-- ДЕЙСТВИЯ   --------------------------------------------------+----------------------------------------------------------------++-- | Отработка onclick +onClick :: String -> WidgetUI -> UI WidgetUI+onClick textScript widget = do+    case wui_element widget of+        EmptyElementUI  -> return widget+        ElementUI a     -> return widget { wui_element = ElementUI   (a ! HA.onclick (toAttrVal textScript)) }+        ContainerUI b   -> return widget { wui_element = ContainerUI (b ! HA.onclick (toAttrVal textScript)) }++onClick_ s w = unsafePerformUI $ onClick s w+{-# DEPRECATED onClick_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Отработка перенаправления на другой URL+onRedirect :: String -> WidgetUI -> UI WidgetUI+onRedirect textURL widget = onClick ("location.href = '" ++ textURL ++ "';") widget++onRedirect_ s w = unsafePerformUI $ onRedirect s w+{-# DEPRECATED onRedirect_ "This is unsafe! It is not recommended to use this function!" #-}+++

+ src/WebUI/Themes/SolarizedUITheme.hs view

@@ -0,0 +1,83 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Тема ГИП: Solarized +----------------------------------------------------------------++module WebUI.Themes.SolarizedUITheme+    ( SolarizedTh (..)+    , thC_03+    , thC_02+    , thC_01+    , thC_00+    , thC_0 +    , thC_1 +    , thC_2 +    , thC_3 +    , thC_Yl+    , thC_Or+    , thC_Rd+    , thC_Mg+    , thC_Vl+    , thC_Bl+    , thC_Cn+    , thC_Gr+    , thC+    ) where++-- Импорт модулей+import           WebUI.Themes.UITheme ++++-- Тип темы+data SolarizedTh = SolarizedTh++instance CUITheme SolarizedTh where+    isTheme _ = True++    rndTh SolarizedTh ThC_03    = "#002b36"+    rndTh SolarizedTh ThC_02    = "#073642"+    rndTh SolarizedTh ThC_01    = "#586e75"+    rndTh SolarizedTh ThC_00    = "#657b83"+    rndTh SolarizedTh ThC_0     = "#839496"+    rndTh SolarizedTh ThC_1     = "#93a1a1"+    rndTh SolarizedTh ThC_2     = "#eee8d5"+    rndTh SolarizedTh ThC_3     = "#fdf6e3"+    rndTh SolarizedTh ThC_Yl    = "#b58900"+    rndTh SolarizedTh ThC_Or    = "#cb4b16"+    rndTh SolarizedTh ThC_Mg    = "#dc322f"+    rndTh SolarizedTh ThC_Rd    = "#d33682"+    rndTh SolarizedTh ThC_Vl    = "#6c71c4"+    rndTh SolarizedTh ThC_Bl    = "#268bd2"+    rndTh SolarizedTh ThC_Cn    = "#2aa198"+    rndTh SolarizedTh ThC_Gr    = "#859900"+    rndTh SolarizedTh (ThC txt) = "#" ++ txt+++-- | Текущая тема UI+currentTheme = SolarizedTh++rndThCur = rndTh currentTheme++++-- | Цвета+thC_03  = rndThCur ThC_03+thC_02  = rndThCur ThC_02+thC_01  = rndThCur ThC_01+thC_00  = rndThCur ThC_00+thC_0   = rndThCur ThC_0+thC_1   = rndThCur ThC_1+thC_2   = rndThCur ThC_2+thC_3   = rndThCur ThC_3+thC_Yl  = rndThCur ThC_Yl+thC_Or  = rndThCur ThC_Or+thC_Rd  = rndThCur ThC_Rd+thC_Mg  = rndThCur ThC_Mg+thC_Vl  = rndThCur ThC_Vl+thC_Bl  = rndThCur ThC_Bl+thC_Cn  = rndThCur ThC_Cn+thC_Gr  = rndThCur ThC_Gr+thC     = rndThCur . ThC +

+ src/WebUI/Themes/UITheme.hs view

@@ -0,0 +1,15 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Тема ГИП +----------------------------------------------------------------++module WebUI.Themes.UITheme+    ( module UITheme+    ) where++-- Импорт модулей+import           WebUI.Themes.UIThemeTypes          as UITheme+++

+ src/WebUI/Themes/UIThemeTypes.hs view

@@ -0,0 +1,65 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Тема ГИП (Типы) +----------------------------------------------------------------++module WebUI.Themes.UIThemeTypes+    ( ThParam       (..)+    , CUIThemeParam (..)+    , CUITheme      (..)+    ) where++-- Импорт модулей++++-- Тип параметров темы+data ThParam =              -- | Фиксированный набор цветов+               ThC_03       -- | base 03 +             | ThC_02       -- | base 02+             | ThC_01       -- | base 01+             | ThC_00       -- | base 00+             | ThC_0        -- | base 0+             | ThC_1        -- | base 1+             | ThC_2        -- | base 2+             | ThC_3        -- | base 3+             | ThC_Yl       -- | yellow+             | ThC_Or       -- | orange+             | ThC_Rd       -- | red+             | ThC_Mg       -- | magenta+             | ThC_Vl       -- | violet+             | ThC_Bl       -- | blue+             | ThC_Cn       -- | cyan+             | ThC_Gr       -- | green+             | ThC String   -- | Другой цвет по имени+                            -- | Фиксированный набор шрифтов+             | ThF_03       -- | Font 03+             | ThF_02       -- | Font 02+             | ThF_01       -- | Font 01+             | ThF_0        -- | Font 0+             | ThF_1        -- | Font 1+             | ThF_2        -- | Font 2+             | ThF_3        -- | Font 3+             | ThF String   -- | Другой шрифт по имени++             | ThPrm String -- | Параметр общий++++-- Класс типа параметра темы +class CUIThemeParam b where+    isThemeParam :: b -> Bool++instance CUIThemeParam ThParam where+    isThemeParam _ = True++++-- Класс темы+class CUITheme a where+    isTheme :: a -> Bool+    rndTh   :: a -> ThParam -> String+++

+ src/WebUI/Themes/UIThemeUtils.hs view

@@ -0,0 +1,85 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Утилиты ГИП +----------------------------------------------------------------++module WebUI.Themes.UIThemeUtils+    ( thC_03+    , thC_02+    , thC_01+    , thC_00+    , thC_0 +    , thC_1 +    , thC_2 +    , thC_3 +    , thC_Yl+    , thC_Or+    , thC_Rd+    , thC_Mg+    , thC_Vl+    , thC_Bl+    , thC_Cn+    , thC_Gr+    , thC+    ) where++-- Импорт модулей+import           WebUI.Themes.UIThemeTypes++++-- | Цвета+thC_03 :: (CUITheme t) => t -> ThParam -> String +thC_03 t p  = rndTh t p++thC_02 :: (CUITheme t) => t -> ThParam -> String +thC_02 t p = rndTh t p++thC_01 :: (CUITheme t) => t -> ThParam -> String +thC_01 t p = rndTh t p++thC_00 :: (CUITheme t) => t -> ThParam -> String +thC_00 t p  = rndTh t p++thC_0 :: (CUITheme t) => t -> ThParam -> String +thC_0 t p = rndTh t p++thC_1 :: (CUITheme t) => t -> ThParam -> String +thC_1 t p = rndTh t p++thC_2 :: (CUITheme t) => t -> ThParam -> String +thC_2 t p = rndTh t p++thC_3 :: (CUITheme t) => t -> ThParam -> String +thC_3 t p = rndTh t p++thC_Yl :: (CUITheme t) => t -> ThParam -> String +thC_Yl t p  = rndTh t p++thC_Or :: (CUITheme t) => t -> ThParam -> String +thC_Or t p = rndTh t p++thC_Rd :: (CUITheme t) => t -> ThParam -> String +thC_Rd t p = rndTh t p++thC_Mg :: (CUITheme t) => t -> ThParam -> String +thC_Mg t p = rndTh t p++thC_Vl :: (CUITheme t) => t -> ThParam -> String +thC_Vl t p = rndTh t p++thC_Bl :: (CUITheme t) => t -> ThParam -> String +thC_Bl t p = rndTh t p++thC_Cn :: (CUITheme t) => t -> ThParam -> String +thC_Cn t p = rndTh t p++thC_Gr :: (CUITheme t) => t -> ThParam -> String +thC_Gr t p = rndTh t p++thC :: (CUITheme t) => t -> ThParam -> String +thC t p = rndTh t p+++

+ src/WebUI/Widgets/Components/UIBase.hs view

@@ -0,0 +1,306 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Базовые компоненты +----------------------------------------------------------------++module WebUI.Widgets.Components.UIBase+    ( wuiPanel   , wuiPanel_+    , wuiWidget  , wuiWidget_+    , wuiCanvas  , wuiCanvas_+    , wuiTextCase, wuiTextCase_++    , IMSrc(..) , wuiImage    , wuiImage_+    , TFVal(..) , wuiTextField, wuiTextField_+    , AHref(..) , wuiLinkA    , wuiLinkA_+    ,             wuiLinkATxt , wuiLinkATxt_++    , textCase , textCase_+    , textSpan , textSpan_+    , textBlock, textBlock_+    , textI    , textI_+    , textB    , textB_+    , textBR   , textBR_+    , textWBR  , textWBR_+    ) where++-- Импорт модулей+--import           Import ++import           Prelude                         as PRL++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           WebUI.Widgets.UIWidget++++----------------------------------------------------------------+-- ВИДЖЕТЫ   ---------------------------------------------------+----------------------------------------------------------------++-- | Виджет панели (Panel)+wuiPanel :: UI WidgetUI+wuiPanel = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "panel"+    where+        elem = ContainerUI $ H.div ++wuiPanel_ = unsafePerformUI $ wuiPanel+{-# DEPRECATED wuiPanel_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Виджет панели с составной структурой (Widget)+wuiWidget :: UI WidgetUI+wuiWidget = do+    panel <- wuiPanel <#> absolute+                      <#> marginNum (3, 3, 3, 3)+                      <#> boundsBRDNum (0, 0, 0, 0) +    panelAbsolute <- wuiPanel <#> absolute+    panelResult <- panelAbsolute `addWUI` panel+    makeAggregativeSTypeUI panelResult++wuiWidget_ = unsafePerformUI $ wuiWidget+{-# DEPRECATED wuiWidget_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Виджет холста (Canvas)+wuiCanvas :: UI WidgetUI+wuiCanvas = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "canvas"+    where+        elem = ContainerUI $ H.canvas++wuiCanvas_ = unsafePerformUI $ wuiCanvas+{-# DEPRECATED wuiCanvas_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Панель текста (TextCase)+wuiTextCase :: String -> UI WidgetUI+wuiTextCase val = do+    panel <- wuiPanel+    textCase <- textCase val+    panel `addWUI` textCase++wuiTextCase_ = unsafePerformUI . wuiTextCase+{-# DEPRECATED wuiTextCase_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Данные источника (пути) к графическому файлу+data IMSrc = IMSrc String++instance CArgumentableWidget (IMSrc -> UI WidgetUI) where +    pack a = a (IMSrc "")  ++-- | Виджет изображения+wuiImage :: IMSrc +         -> UI WidgetUI+wuiImage (IMSrc val) = do+    uuid <- generateUUID+    return $ (createWidgetUI elem uuid "textField") {wui_postBuild = postBuild }+    where+        elem :: ElementUI+        elem = ElementUI $ H.img++        postBuild :: ElementUI -> ElementUI+        postBuild (ElementUI e) = ElementUI $ if val == "" +                                              then e +                                              else e ! HA.src (toAttrVal val)++wuiImage_ = unsafePerformUI . wuiImage+{-# DEPRECATED wuiImage_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Данные значения текстового поля+data TFVal = TFVal String++instance CArgumentableWidget (TFVal -> UI WidgetUI) where +    pack a = a (TFVal "")  ++-- | Виджет текстового поля+wuiTextField :: TFVal +             -> UI WidgetUI+wuiTextField (TFVal val) = do+    uuid <- generateUUID+    return $ (createWidgetUI elem uuid "textField") {wui_postBuild = postBuild }+    where+        elem :: ElementUI+        elem = ElementUI $ H.input ++        postBuild :: ElementUI -> ElementUI+        postBuild (ElementUI e) = ElementUI $ if val == "" +                                              then e +                                              else e ! HA.value (toAttrVal val)++wuiTextField_ = unsafePerformUI . wuiTextField+{-# DEPRECATED wuiTextField_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Данные href ссылки A+data AHref = AHref+           | AHUrl String++instance CArgumentableWidget (AHref -> UI WidgetUI) where +    pack a = a AHref  ++instance Show AHref where+    show AHref     = "#"+    show (AHUrl a) = a+++-- | Виджет ссылки A+wuiLinkA :: AHref +         -> UI WidgetUI+wuiLinkA h = do+    uuid <- generateUUID+    return $ (createWidgetUI elem uuid "textField") {wui_postBuild = postBuild }+    where+        elem :: ElementUI+        elem = ContainerUI $ H.a++        postBuild :: ElementUI -> ElementUI+        postBuild (ContainerUI e) = let val = show h in +                                   ContainerUI $ if val == "" +                                                 then e +                                                 else e ! HA.src (toAttrVal val)++wuiLinkA_ = unsafePerformUI . wuiLinkA+{-# DEPRECATED wuiLinkA_ "This is unsafe! It is not recommended to use this function!" #-}+++-- | Виджет ссылки A с текстом+wuiLinkATxt :: AHref +            -> String+            -> UI WidgetUI+wuiLinkATxt h txt = do+    uuid <- generateUUID+    return $ (createWidgetUI elem uuid "textField") {wui_postBuild = postBuild }+    where+        elem :: ElementUI+        elem = ElementUI $ H.a $ toHtml txt++        postBuild :: ElementUI -> ElementUI+        postBuild (ElementUI e) = let val = show h in +                                  ElementUI $ if val == "" +                                              then e +                                              else e ! HA.src (toAttrVal val)++wuiLinkATxt_ h t = unsafePerformUI $ wuiLinkATxt h t+{-# DEPRECATED wuiLinkATxt_ "This is unsafe! It is not recommended to use this function!" #-}++++----------------------------------------------------------------+-- ТЕКСТ   -----------------------------------------------------+----------------------------------------------------------------++-- | Текст  +textCase :: String +         -> UI WidgetUI+textCase val = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textCase"+    where+        elem = ElementUI $ toHtml val ++textCase_ = unsafePerformUI . textCase+{-# DEPRECATED textCase_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Текст элемента +textSpan :: String +         -> UI WidgetUI+textSpan val = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textSpan"+    where+        elem = ElementUI $ H.span $ toHtml val ++textSpan_ = unsafePerformUI . textSpan+{-# DEPRECATED textSpan_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Текст блочный элемента +textBlock :: String +         -> UI WidgetUI+textBlock val = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textBlock"+    where+        elem = ElementUI $ H.div $ toHtml val ++textBlock_ = unsafePerformUI . textBlock+{-# DEPRECATED textBlock_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Текст элемента наклонный+textI :: String +      -> UI WidgetUI+textI val = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textI"+    where+        elem = ElementUI $ H.i $ toHtml val++textI_ = unsafePerformUI . textI+{-# DEPRECATED textI_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Текст элемента наклонный+textB :: String +      -> UI WidgetUI+textB val = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textB"+    where+        elem = ElementUI $ H.b $ toHtml val++textB_ = unsafePerformUI . textB+{-# DEPRECATED textB_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Разрыв строки текста +textBR :: UI WidgetUI+textBR = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textBR"+    where+        elem = ElementUI $ H.br ++textBR_ = unsafePerformUI $ textBR+{-# DEPRECATED textBR_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Указание допустимого места переноса строки текста +textWBR :: UI WidgetUI+textWBR = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "textWBR"+    where+        elem = ElementUI $ H.wbr ++textWBR_ = unsafePerformUI $ textWBR+{-# DEPRECATED textWBR_ "This is unsafe! It is not recommended to use this function!" #-}+++

+ src/WebUI/Widgets/Extensions/BootStrapExtension.hs view

@@ -0,0 +1,105 @@+----------------------------------------------------------------+-- Модуль приложения+-- Расширение графического интерфейса (ExtensionUI)+-- Инструментарий Bootstrap+----------------------------------------------------------------++module WebUI.Widgets.Extensions.BootStrapExtension+    ( bootStrapExtension++    , bootStrap_Btn++    , bootStrap_BtnDefault+    , bootStrap_BtnPrimary+    , bootStrap_BtnSuccess+    , bootStrap_BtnInfo +    , bootStrap_BtnWarning+    , bootStrap_BtnDanger +    , bootStrap_BtnLink ++    , bootStrap_BtnLG+    , bootStrap_BtnMD+    , bootStrap_BtnSM+    , bootStrap_BtnXS++    ) where++-- Импорт модулей+import           Prelude                         as PRL++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Widgets.UIWidget+import           WebUI.Widgets.Components.UIBase++++-- | Метод подключения расширения всплывающей подсказки (ToolTipExtension)+bootStrapExtension :: WidgetUI -> UI WidgetUI+bootStrapExtension shell = do+    uuid <- generateUUID+    extension <- return $ createWidgetUI elem uuid "extension_ToolTipExtension"+    extension <- return $ extension { wui_scripts = (wui_scripts shell) ++ [ H.script ! src "/bootstrap.js" $ ""+                                                          , H.link ! rel "stylesheet" ! type_ "text/css" ! href "/bootstrap.css" +                                                          , H.link ! rel "stylesheet" ! type_ "text/css" ! href "/bootstrap-theme.css" +                                                          , H.link ! rel "stylesheet" ! type_ "text/css" ! href "/bootstrap-solarized-dark.css" +                                                          ] +                                    }+    shell `addWUI` extension+    where+        elem = EmptyElementUI +++bootStrap_Btn :: WidgetUI -> UI WidgetUI+bootStrap_Btn = classToWidget "btn"++++bootStrap_BtnDefault :: WidgetUI -> UI WidgetUI+bootStrap_BtnDefault = classToWidget "btn-default"++bootStrap_BtnPrimary :: WidgetUI -> UI WidgetUI+bootStrap_BtnPrimary = classToWidget "btn-primary"++bootStrap_BtnSuccess :: WidgetUI -> UI WidgetUI+bootStrap_BtnSuccess = classToWidget "btn-success"++bootStrap_BtnInfo :: WidgetUI -> UI WidgetUI+bootStrap_BtnInfo = classToWidget "btn-info"++bootStrap_BtnWarning :: WidgetUI -> UI WidgetUI+bootStrap_BtnWarning = classToWidget "btn-warning"++bootStrap_BtnDanger :: WidgetUI -> UI WidgetUI+bootStrap_BtnDanger = classToWidget "btn-danger"++bootStrap_BtnLink :: WidgetUI -> UI WidgetUI+bootStrap_BtnLink = classToWidget "btn-link"+++ +bootStrap_BtnLG :: WidgetUI -> UI WidgetUI+bootStrap_BtnLG = classToWidget "btn-lg"++bootStrap_BtnMD :: WidgetUI -> UI WidgetUI+bootStrap_BtnMD = classToWidget "btn-md"++bootStrap_BtnSM :: WidgetUI -> UI WidgetUI+bootStrap_BtnSM = classToWidget "btn-sm"++bootStrap_BtnXS :: WidgetUI -> UI WidgetUI+bootStrap_BtnXS = classToWidget "btn-xs"+++

+ src/WebUI/Widgets/Extensions/JQueryExtension.hs view

@@ -0,0 +1,42 @@+----------------------------------------------------------------+-- Модуль приложения+-- Расширение графического интерфейса (ExtensionUI)+-- Библиотека jQuery+----------------------------------------------------------------++module WebUI.Widgets.Extensions.JQueryExtension+    ( jQueryExtension+    ) where++-- Импорт модулей+import           Prelude                         as PRL++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Widgets.UIWidget+import           WebUI.Widgets.Components.UIBase++++-- | Метод подключения расширения библиотеки jQuery (JQueryExtension)+jQueryExtension :: WidgetUI -> UI WidgetUI+jQueryExtension shell = do+    uuid <- generateUUID+    extension <- return $ createWidgetUI elem uuid "extension_jQuery"+    extension <- return $ extension { wui_scripts = (wui_scripts shell) ++ [H.script ! src "/jquery.js" $ ""] }+    shell `addWUI` extension+    where+        elem = EmptyElementUI ++

+ src/WebUI/Widgets/Extensions/MapOSMExtension.hs view

@@ -0,0 +1,46 @@+----------------------------------------------------------------+-- Модуль приложения+-- Расширение графического интерфейса (ExtensionUI)+-- Карта OSM+----------------------------------------------------------------++module WebUI.Widgets.Extensions.MapOSMExtension+    ( mapOSMExtension+    ) where++-- Импорт модулей+import           Prelude                         as PRL++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Widgets.UIWidget+import           WebUI.Widgets.Components.UIBase++++-- | Метод подключения расширения карты OSM (MapOSMExtension)+mapOSMExtension :: WidgetUI -> UI WidgetUI+mapOSMExtension shell = do+    uuid <- generateUUID+    extension <- return $ createWidgetUI elem uuid "extension_MapOSM"+    extension <- return $ extension { wui_scripts = (wui_scripts shell) ++ +                                                          [ H.script ! src "/ol.js" $ ""+                                                          , H.link ! rel "stylesheet" ! type_ "text/css" ! href "/ol.css" +                                                          ] +                                    }+    shell `addWUI` extension+    where+        elem = EmptyElementUI ++

+ src/WebUI/Widgets/Extensions/ToolTipExtension.hs view

@@ -0,0 +1,117 @@+----------------------------------------------------------------+-- Модуль приложения+-- Расширение графического интерфейса (ExtensionUI)+-- Всплывающая подсказка+----------------------------------------------------------------++module WebUI.Widgets.Extensions.ToolTipExtension+    ( toolTipExtension++    , extToolTip+    , extToolTipW+    ) where++-- Импорт модулей+import           Prelude                         as PRL++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Widgets.UIWidget+import           WebUI.Widgets.Components.UIBase++++-- | Подготовка CSS+prepareCSS a = toHtml $ renderCssUrl undefined a++++-- http://www.w3schools.com/howto/howto_css_tooltip.asp++-- | Метод подключения расширения всплывающей подсказки (ToolTipExtension)+toolTipExtension :: WidgetUI -> UI WidgetUI+toolTipExtension shell = do+    uuid <- generateUUID+    extension <- return $ createWidgetUI elem uuid "extension_ToolTipExtension"+    extension <- return $ extension { wui_styles = (wui_styles extension) ++ [H.style $ do +        prepareCSS ([cassius|+            .tooltip +                position: relative+                display: inline-block+            +            .tooltip .tooltiptext +                visibility: hidden+                width: auto+                min-width: 120px+                background-color: #555+                color: #fff+                text-align: center+                border-radius: 6px+                padding: 5px 0+                position: absolute+                z-index: 100000+                bottom: 125%+                left: 50%+                margin-left: -60px+                opacity: 0+                transition: opacity 1s+++            .tooltip .tooltiptext::after +                content: ""+                position: absolute+                top: 100%+                left: 50%+                margin-left: -5px+                border-width: 5px+                border-style: solid+                border-color: #555 transparent transparent transparent++            .tooltip:hover .tooltiptext +                visibility: visible+                opacity: 1+        |] )] }+    --extension <- return $ extension { wui_styles = (wui_styles extension) ++ [H.style ".test_qwerty {position: display;}"] }+    shell `addWUI` extension+    where+        elem = EmptyElementUI ++++-- | Добавление всплывающей подсказки с текстом+extToolTip :: String -> WidgetUI -> UI WidgetUI+extToolTip val widget = do +    case (wui_element widget) of+            ContainerUI f   -> do widget <- classToWidget "tooltip" widget +                                            `addWUImms` +                                            [textSpan val <#> classToWidget "tooltiptext"]+                                  return widget+            ElementUI e     -> do return widget+            EmptyElementUI  -> do return widget++++-- | Добавление всплывающей подсказки с виджетом+extToolTipW :: WidgetUI -> WidgetUI -> UI WidgetUI+extToolTipW valw widget = do +    case (wui_element widget) of+            ContainerUI f   -> do widget <- classToWidget "tooltip" widget +                                            `addWUImms` +                                            [classToWidget "tooltiptext" valw]+                                  return widget+            ElementUI e     -> do return widget+            EmptyElementUI  -> do return widget+++

+ src/WebUI/Widgets/Kits/UIKits.hs view

@@ -0,0 +1,28 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Наборы Kits +----------------------------------------------------------------++module WebUI.Widgets.Kits.UIKits+    ( kitContCenterFlex, kitContCenterFlex_ +    ) where++-- Импорт модулей++import           Prelude                         as PRL++import           WebUI.Widgets.UIWidget++++-- | Набор для центрирования содержимого по горизонтали и вертикали+kitContCenterFlex :: WidgetUI -> UI WidgetUI+kitContCenterFlex widget = +    (return widget) <#> flexD+                    <#> styleToWidget "align-items: center; justify-content: center;"+        +kitContCenterFlex_ = unsafePerformUI . kitContCenterFlex+++

+ src/WebUI/Widgets/UIWidget.hs view

@@ -0,0 +1,2031 @@+----------------------------------------------------------------+-- Модуль приложения+-- Графический интерфейс (UI)+-- Виджет ГИП +----------------------------------------------------------------++module WebUI.Widgets.UIWidget+    ( UI (..)+    , AdaptableUI+    , UIColor (..)+    , UIPosition (..)+    , UIImage (..)+    , WidgetUI (..) +    , StructureTypeUI (..) +    , ElementUI (..) +--    , MonadUI (..)++    , CArgumentableWidget+    , pack++    , (<#>)+    , (<~>)+    , (##)+    , liftUI+    , unsafePerformUI+    , packWidgetUI+    , expandWUI+    , makeBaseSTypeUI, makeAggregativeSTypeUI+    , generateUUID, generateUUID_+    , toAttrVal+    , generateValueUUID+    , createWidgetUI+    , requare++    , absolute, fixed, relative, static, inherit++    , block, inline, inline_block, inline_table, list_item, none, run_in, tableD, table_caption, table_cell +    , table_column_group, table_column, table_footer_group, table_header_group, table_row, table_row_group+    , flexD++    , cursorAuto, cursorCrosshair, cursorDefault, cursorEResize, cursorHelp, cursorMove, cursorNResize, cursorNEResize, cursorNWResize +    , cursorPointer, cursorProgress, cursorSResize, cursorSEResize, cursorSWResize, cursorText, cursorWResize, cursorWait, cursorInherit +    , cursorImage++    , overflowAuto , overflowHidden , overflowScroll , overflowVisible , overflowInherit+    , overflowAutoX, overflowHiddenX, overflowScrollX, overflowVisibleX, overflowInheritX+    , overflowAutoY, overflowHiddenY, overflowScrollY, overflowVisibleY, overflowInheritY++    , BGRepeat (..), BGAttachment (..), BGSize (..)+    , background, backgroundColor, backgroundRepeat, backgroundAttachment, backgroundImage, backgroundSize++    , BorderStyle (..)+    , border, border_left, border_right, border_top, border_bottom+    , borderNone, border_leftNone, border_rightNone, border_topNone, border_bottomNone+    , borderRadius, borderRadiusNum, borderRadiusStr, borderRadiusExt++    , UI_StartingPoint (..), HSize (..)+    , bounds , boundsNum , boundsStr , boundsExt , boundsBRD , boundsBRDNum , boundsBRDStr , boundsBRDExt++    , margin, marginNum, marginStr, marginExt, marginAll, marginAllNum, marginAllStr, marginAllExt++    , marginLeft  , marginLeftNum  , marginLeftStr  , marginLeftExt   +    , marginRight , marginRightNum , marginRightStr , marginRightExt  +    , marginTop   , marginTopNum   , marginTopStr   , marginTopExt    +    , marginBottom, marginBottomNum, marginBottomStr, marginBottomExt ++    , padding, paddingNum, paddingStr, paddingExt, paddingAll, paddingAllNum, paddingAllStr, paddingAllExt++    , paddingLeft  , paddingLeftNum  , paddingLeftStr  , paddingLeftExt   +    , paddingRight , paddingRightNum , paddingRightStr , paddingRightExt  +    , paddingTop   , paddingTopNum   , paddingTopStr   , paddingTopExt    +    , paddingBottom, paddingBottomNum, paddingBottomStr, paddingBottomExt ++    , wwidth    , widthNum    , widthStr    , widthExt+    , wwidthMin , widthMinNum , widthMinStr , widthMinExt+    , wwidthMax , widthMaxNum , widthMaxStr , widthMaxExt+    +    , wheight   , heightNum   , heightStr   , heightExt+    , wheightMin, heightMinNum, heightMinStr, heightMinExt+    , wheightMax, heightMaxNum, heightMaxStr, heightMaxExt+    +    , wsize  , sizeNum  , sizeStr  , sizeExt++    , left  , leftNum  , leftStr  , leftExt+    , right , rightNum , rightStr , rightExt+    , top   , topNum   , topStr   , topExt+    , bottom, bottomNum, bottomStr, bottomExt++    , foreground++    , fill++    , FFamily (..), FSize (..), FontStyle (..), FontWeight (..) +    , UIFont (..)+    , ffSerif, ffSansSerif, ffCursive, ffFantasy, ffMonospace+    , font, fontFamily, fontSize, fontStyle, fontWeight++    , zIndex++    , classToWidget +    , styleToWidget++    , tooltip + +    , hover, hoverm++    , addWUI, addWUI_, addWUIs, addWUIs_, addWUIm, addWUImm, addWUIsm, addWUIms, addWUImms+    , addWUIcf, addWUIcfs++    , DecoratorUI (..)+    , forLoopUI++    , shellUI, shellExtUI+    , wuiElement, wuiElement_+    , wuiHTML, wuiHTML_+    , wuiScriptSrc+    , wuiStyleHref+    , wuiScriptJS, wuiScriptJSs+    , wuiScriptTextJS, wuiScriptTextJSs+    , wuiCSS, wuiCSSs+    ) where++-- Импорт модулей+--import           Import ++import           Prelude                         as PRL+import           Data.Maybe                      (fromJust)+import           System.IO+import           Control.Monad.IO.Class+--import Control.Monad (MonadPlus(mzero, mplus), liftM, ap)++import qualified Text.Blaze                      as TB+import qualified Text.Blaze.Html5                as H+import           Text.Blaze.Html5                +import qualified Text.Blaze.Html5.Attributes     as HA+import           Text.Blaze.Html5.Attributes     +import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Internal             as TBI++import           System.IO.Unsafe             (unsafePerformIO)+import           System.Process+--import           System.Exit++import           Data.UUID                       as UV+import           Data.UUID.V1                    as UV1+import           Data.UUID.V4                    as UV4+import           Data.UUID.V5                    as UV5+import           System.Random+import           Text.Hamlet+import           Text.Lucius+import           Text.Cassius+import           Text.Julius++import           WebUI.Themes.UITheme+import           WebUI.Themes.SolarizedUITheme+++--type WUI a = StateT s m a+--type WUI a = StateT SettingsUI IO a++--data UI a = UI { unUI :: a } +--             deriving Functor+++--instance Applicative UI where+--    pure   = UI+--    m *>  k = m >>= \ _ -> k+--    m <*  k = m >>= \ _ -> m+--    m <*> k = UI $ (unUI m) (unUI k)+++--instance Monad UI where+--    m >>  k = m >>= \ _ -> k+--    m >>= k = k $ unUI m+--    return  = UI+++--data SettingsUI = SettingsUI { uiLocal :: String }+++--instance MonadIO UI where+--    liftIO a = return $ memo $ unsafePerformIO a++--bindUI :: UI a -> (a -> UI b) -> UI b+--bindUI (UI m) k = UI (\ s -> case m s of (# new_s, a #) -> unUI (k a) new_s)++-- | Тип UI+type UI = IO+++-- | Общий класс всех типов адаптированных для работы в UI+class AdaptableUI a where+    isAdapterUI :: a -> Bool+++--class (Monad m) => MonadUI m where+--    -- | Lift a computation from the 'IO' monad.+--    liftUI :: UI a -> m a+++    +--instance MonadUI UI where+--    liftUI = PRL.id    +++liftUI a = liftIO a++--unsafePerformUI = unUI+unsafePerformUI = unsafePerformIO+{-# DEPRECATED unsafePerformUI "This is unsafe! It is not recommended to use this function!" #-}+++-- | Тип цвета+type UIColor = String++-- | Тип положения+data UIPosition = UILeft | UIRight | UITop | UIBottom | UICenter | UIInherit+instance Show UIPosition where+    show UILeft    = "left"+    show UIRight   = "right"+    show UITop     = "top"+    show UIBottom  = "bottom"+    show UICenter  = "center"+    show UIInherit = "inherit"++-- | Давнные изображения+data UIImage = ImageEmpty+             | ImageURL String+             | ImageBase64 String String++instance Show UIImage where+    show ImageEmpty        = "";+    show (ImageURL url)    = "url('" ++ url ++ "')"+    show (ImageBase64 t b) = "url('data:image/" ++ t ++ ";base64," ++ b ++ "')"+++-- | Тип структуры UI+data StructureTypeUI = BaseSTypeUI+                     | AggregativeSTypeUI+                     deriving Show++++-- | Элемент UI+data ElementUI = EmptyElementUI +               | ElementUI H.Html+               | ContainerUI (H.Html -> H.Html)+++instance Show ElementUI where+    show EmptyElementUI           = "EmptyElementUI"+    show (ElementUI a)            = "EmptyUI (" ++ (show a) ++ ")"+    show _                        = "ContainerUI (" ++ "H.Html -> H.Html"  ++ ")"+    --show (ContainerUI (a -> b))   = "(" ++ (show a) ++ ")"++instance Show (ElementUI -> ElementUI) where+    show _           = "Builder"+++-- | Данные виджета UI+data WidgetUI = EmptyUI                                                  -- ^ Пустой UI+              | WidgetUI { wui_title      :: H.Html                      -- ^ Заголовок страницы+                         , wui_id         :: String                      -- ^ ID виджета+                         , wui_ui_name    :: String                      -- ^ Наименование комопонента виджета+                         , wui_attr_style :: String                      -- ^ Атрибут стилей+                         , wui_attr_class :: String                      -- ^ Атрибут классов+                         , wui_styles     :: [H.Html]                    -- ^ Массив стилей для HEAD раздела страницы+                         , wui_scripts    :: [H.Html]                    -- ^ Массив скриптов для HEAD раздела страницы+                         , wui_contents   :: [H.Html]                    -- ^ Массив содержимого для BODY раздела страницы (глобальный)+                         , wui_children   :: [WidgetUI]                  -- ^ Дочерние виджеты+                         , wui_strTypeUI  :: StructureTypeUI             -- ^ Тип структуры UI виджета+                         , wui_element    :: ElementUI                   -- ^ Элемент UI виджета+                         , wui_preBuild   :: (ElementUI -> ElementUI)    -- ^ Предварительный строитель+                         , wui_postBuild  :: (ElementUI -> ElementUI)    -- ^ Заключительный строитель+                         } deriving Show+++instance Show H.Html where+    show = renderHtml ++instance Show AttributeValue where+    show _  = "AttributeValue" +++-- | Значение по умолчанию данных виджета UI+defaultWidgetUI :: UI WidgetUI+defaultWidgetUI = do +    uuid <- generateUUID+    return $ WidgetUI { wui_title      = ""              -- ^ Заголовок страницы+                      , wui_id         = uuid            -- ^ ID виджета+                      , wui_ui_name    = "shell"         -- ^ Наименование компонента виджета+                      , wui_attr_style = ""              -- ^ Атрибут стилей+                      , wui_attr_class = ""              -- ^ Атрибут классов+                      , wui_styles     = []              -- ^ Массив стилей для HEAD раздела страницы+                      , wui_scripts    = []              -- ^ Массив скриптов для HEAD раздела страницы+                      , wui_contents   = []              -- ^ Массив содержимого для BODY раздела страницы (глобальный)+                      , wui_children   = []              -- ^ Дочерние виджеты+                      , wui_strTypeUI  = BaseSTypeUI     -- ^ Тип структуры UI виджета+                      , wui_element    = EmptyElementUI  -- ^ Элемент UI виджета+                      , wui_preBuild   = (\x -> x)       -- ^ Предварительный строитель+                      , wui_postBuild  = (\x -> x)       -- ^ Заключительный строитель+                      }++++-- | Создать данные виджета UI+createWidgetUI :: ElementUI -> String -> String -> WidgetUI+createWidgetUI element uuid ui_name = +    WidgetUI { wui_title      = ""                            -- ^ Заголовок страницы+             , wui_id         = uuid                          -- ^ ID виджета+             , wui_ui_name    = ui_name                       -- ^ Наименование компонента виджета+             , wui_attr_style = ""                            -- ^ Атрибут стилей+             , wui_attr_class = ""                            -- ^ Атрибут классов+             , wui_styles     = []                            -- ^ Массив стилей для HEAD раздела страницы+             , wui_scripts    = []                            -- ^ Массив скриптов для HEAD раздела страницы+             , wui_contents   = []                            -- ^ Массив содержимого для BODY раздела страницы (глобальный)+             , wui_children   = []                            -- ^ Дочерние виджеты+             , wui_strTypeUI  = BaseSTypeUI                   -- ^ Тип структуры UI виджета+             , wui_element    = element                       -- ^ Элемент UI виджета+             , wui_preBuild   = (\x -> x)                     -- ^ Предварительный строитель+             , wui_postBuild  = (\x -> x)                     -- ^ Заключительный строитель+             }++++-- | Сделать структурный тип виджета Base+makeBaseSTypeUI :: WidgetUI +                -> UI WidgetUI+makeBaseSTypeUI widget = do+    return $ widget {wui_strTypeUI = BaseSTypeUI}++++-- | Сделать структурный тип виджета Aggregative+makeAggregativeSTypeUI :: WidgetUI +                       -> UI WidgetUI+makeAggregativeSTypeUI widget = do+    return $ widget {wui_strTypeUI = AggregativeSTypeUI}++++-- | Сгенерировать UUID+--generateUUID :: UI String+--generateUUID = do+--    muuid <- UV1.nextUUID +--    case muuid of+--        Just uuid   -> do return $ UV.toString uuid +--        Nothing     -> do ruuid <- UV4.nextRandom+--                          return $ UV.toString ruuid++--generateUUID :: IO String+--generateUUID = UV.toString . fromJust <$> UV1.nextUUID++generateUUID :: UI String+generateUUID = do +    ruuid <- UV4.nextRandom+--    ruuid <- liftIO $ UV4.nextRandom+    return $ UV.toString ruuid++generateUUID_ = unsafePerformUI generateUUID+{-# DEPRECATED generateUUID_ "This is unsafe! It is not recommended to use this function!" #-}++-- | Перевести в значение AttributeValue+toAttrVal = TB.toValue+++++-- | Сгенерировать UUID как значение AttributeValue+generateValueUUID :: AttributeValue+generateValueUUID = TB.toValue generateValueUUID++++-- | Применить виджет к виджету+appendUI :: WidgetUI -> WidgetUI -> UI WidgetUI+appendUI w_1 w_2 = do+    return $ w_1 { wui_children = (wui_children w_1) ++ [w_2] }++++-- | Добавить виджет к виджету+addWUI :: WidgetUI -> WidgetUI -> UI WidgetUI+addWUI w_1 w_2 = do+    case (wui_strTypeUI w_1) of+        BaseSTypeUI         -> return $ w_1 { wui_children = (wui_children w_1) ++ [w_2] }+        AggregativeSTypeUI  -> addWUIcf w_1 w_2++addWUI_ w_1 w_2 = unsafePerformUI $ addWUI w_1 w_2+{-# DEPRECATED addWUI_ "This is unsafe! It is not recommended to use this function!" #-}+++-- | Добавить виджет к виджету (виджет в монаде UI)+addWUIm :: WidgetUI -> UI WidgetUI -> UI WidgetUI+addWUIm w_1 w_2 = do+    a2 <- w_2+    addWUI w_1 a2+++-- | Добавить виджет к виджету (виджеты в монаде UI)+addWUImm :: UI WidgetUI -> UI WidgetUI -> UI WidgetUI+addWUImm w_1 w_2 = do+    a1 <- w_1+    a2 <- w_2+    addWUI a1 a2+++-- | Добавить виджеты к виджету+addWUIs :: WidgetUI -> [WidgetUI] -> UI WidgetUI+addWUIs p [] = do return p+addWUIs p (x:xs) = do +    result <- addWUI p x+    addWUIs result xs++addWUIs_ w_1 w_2 = unsafePerformUI $ addWUIs w_1 w_2+{-# DEPRECATED addWUIs_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Добавить виджеты к виджету (виджеты в монаде UI)+addWUIsm :: UI WidgetUI -> UI [WidgetUI] -> UI WidgetUI+addWUIsm w_1 w_2 = do +    a1 <- w_1+    a2 <- w_2+    addWUIs a1 a2 ++++-- | Добавить виджеты к виджету (массив виджетов в монаде UI)+addWUIms :: WidgetUI -> [UI WidgetUI] -> UI WidgetUI+addWUIms w_1 [] = do return w_1+addWUIms w_1 (x:xs) = do +    a <- x+    r <- addWUI w_1 a +    addWUIms r xs++++-- | Добавить виджеты к виджету (виджет и массив виджетов в монаде UI)+addWUImms :: UI WidgetUI -> [UI WidgetUI] -> UI WidgetUI+addWUImms w_1 ws = do +    w <- w_1+    addWUIms w ws++++-- | Добавить виджет к первому дочерниму виджету виджета+addWUIcf :: WidgetUI -> WidgetUI -> UI WidgetUI+addWUIcf w_1 w_2 = do+    chl <- return $ wui_children w_1+    case chl of+        []      -> appendUI w_1 w_2+        (x:xs)  -> do cf <- x `addWUI` w_2+                      return w_1 { wui_children = [cf] ++ xs }+++-- | Добавить виджеты к первому дочерниму виджету виджета+addWUIcfs :: WidgetUI -> [WidgetUI] -> UI WidgetUI+addWUIcfs p [] = do return p+addWUIcfs p (x:xs) = do +    result <- addWUIcf p x+    addWUIs result xs++++-- | Тип декоратора UI+type DecoratorUI a = WidgetUI -> a -> UI WidgetUI++-- | Цикл петли прохода по списку в UI+forLoopUI :: WidgetUI       -- ^ Родительский виджет+          -> [a]            -- ^ Список+          -> DecoratorUI a  -- ^ Декоратор+          -> UI WidgetUI    -- ^ Результат+forLoopUI parent []     _      = do +    return parent+forLoopUI parent (x:xs) action = do+    parentNext <- action parent x+    forLoopUI parentNext xs action++++-- | Класс для реализации заполнения частично примененных атрибутов+class CArgumentableWidget a where+    pack :: a -> UI WidgetUI++instance CArgumentableWidget (UI WidgetUI) where pack a = a  ++++-- | Класс для реализации заполнения частично примененных атрибутов+class CArgumentableAttr a where+    expressArgumentAttr :: a -> (WidgetUI -> UI WidgetUI)++instance CArgumentableAttr (WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a  ++++-- | Применить атрибуты через адаптеры функции+--(<#>) :: UI WidgetUI -> (WidgetUI -> UI WidgetUI) -> UI WidgetUI+--(<#>) w wfn  = do {a <- w; wfn a; }+(<#>) :: CArgumentableAttr a => UI WidgetUI -> a -> UI WidgetUI+(<#>) w wfn = do +    a <- w +    (expressArgumentAttr wfn) a+infixl 9 <#>+++(<~>) :: CArgumentableAttr a => WidgetUI -> a -> WidgetUI+{-# DEPRECATED (<~>) "This is unsafe! It is not recommended to use this function!" #-}+(<~>) w wfn = do +    unsafePerformUI $ (expressArgumentAttr wfn) w+infixl 9 <~>+++-- | Применить аттрибуты Blaze+(##) :: UI WidgetUI -> Attribute -> UI WidgetUI+(##) a atr  = do+    w <- a+    element <- return $ wui_element w+    case element of+        ContainerUI f   -> do return w { wui_element = ContainerUI (f ! atr) }+        ElementUI e     -> do return w { wui_element = ElementUI (e ! atr) }+        EmptyElementUI  -> do return w+        --otherwise       -> do return w { wui_element = element ! atr }+infixl 9 ##++++-- | Упаковать виджет для представления в Blaze+--   с применением атрибутов+packWidgetUI :: WidgetUI -> WidgetUI+packWidgetUI widget =+    case (wui_element widget) of+            ContainerUI f   -> widget { wui_element = a_postBuild . ContainerUI $ f ! HA.id a_uuid +                                                                                    ! TBI.customAttribute "ui_widget" a_ui_name +                                                                                    ! HA.style a_styles +                                                                                    ! HA.class_ a_classes+                                      }+            ElementUI e     -> widget { wui_element = a_postBuild . ElementUI   $ e ! HA.id a_uuid +                                                                                    ! TBI.customAttribute "ui_widget" a_ui_name +                                                                                    ! HA.style a_styles +                                                                                    ! HA.class_ a_classes+                                      }+            EmptyElementUI  -> widget+    where+        a_uuid      = toAttrVal . wui_id         $ widget+        a_ui_name   = toAttrVal . wui_ui_name    $ widget+        a_styles    = toAttrVal . wui_attr_style $ widget+        a_classes   = toAttrVal . wui_attr_class $ widget+        a_preBuild  =             wui_preBuild   $ widget+        a_postBuild =             wui_postBuild  $ widget++++-- | Разобрать элемент+expandWUI :: UI WidgetUI +          -> UI (WidgetUI, String, String)+expandWUI widget = do+    w <- widget+    return (w, (wui_id w), (wui_ui_name w))++++-- | Подключение расширения+requare :: WidgetUI -> (WidgetUI -> UI WidgetUI) -> UI WidgetUI+requare shell extensionDo = do+    extensionDo shell++++-----------------------------------------------------------------------------------------------+-- Адаптеры атрибутов   -----------------------------------------------------------------------+-----------------------------------------------------------------------------------------------++-- | Способ позиционирования элемента absolute+absolute :: WidgetUI -> UI WidgetUI+absolute widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "position: absolute;" }+ +-- | Способ позиционирования элемента fixed+fixed :: WidgetUI -> UI WidgetUI+fixed widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "position: fixed;" }++-- | Способ позиционирования элемента relative+relative :: WidgetUI -> UI WidgetUI+relative widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "position: relative;" }++-- | Способ позиционирования элемента static+static :: WidgetUI -> UI WidgetUI+static widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "position: static;" }++-- | Способ позиционирования элемента inherit+inherit :: WidgetUI -> UI WidgetUI+inherit widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "position: inherit;" }++++-- | Способ отображения block+block :: WidgetUI -> UI WidgetUI+block widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: block;" }++-- | Способ отображения inline +inline :: WidgetUI -> UI WidgetUI+inline widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: inline;" }++-- | Способ отображения inline_block+inline_block :: WidgetUI -> UI WidgetUI+inline_block widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: inline-block;" }++-- | Способ отображения inline_table+inline_table :: WidgetUI -> UI WidgetUI+inline_table widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: inline-table;" }++-- | Способ отображения list_item+list_item :: WidgetUI -> UI WidgetUI +list_item widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: list-item;" }++-- | Способ отображения none+none :: WidgetUI -> UI WidgetUI+none widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: none;" }++-- | Способ отображения run_in+run_in :: WidgetUI -> UI WidgetUI+run_in widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: run-in;" }++-- | Способ отображения table+tableD :: WidgetUI -> UI WidgetUI+tableD widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table;" }++-- | Способ отображения table_caption+table_caption :: WidgetUI -> UI WidgetUI+table_caption widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-caption;" }++-- | Способ отображения table_cell+table_cell :: WidgetUI -> UI WidgetUI+table_cell widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-cell;" }++-- | Способ отображения +table_column_group :: WidgetUI -> UI WidgetUI+table_column_group widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-column-group;" }++-- | Способ отображения table_column+table_column :: WidgetUI -> UI WidgetUI+table_column widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-column;" }++-- | Способ отображения table_footer_group+table_footer_group :: WidgetUI -> UI WidgetUI+table_footer_group widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-footer-group;" }++-- | Способ отображения table_header_group+table_header_group :: WidgetUI -> UI WidgetUI+table_header_group widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-header-group;" }++-- | Способ отображения table_row+table_row :: WidgetUI -> UI WidgetUI+table_row widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-row;" }++-- | Способ отображения table_row_group+table_row_group :: WidgetUI -> UI WidgetUI+table_row_group widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: table-row-group;" }++-- | Способ отображения flex+flexD :: WidgetUI -> UI WidgetUI+flexD widget = do return widget { wui_attr_style = (wui_attr_style widget) ++ "display: flex;" }++++-- | Курсор auto+cursorAuto :: WidgetUI -> UI WidgetUI+cursorAuto widget = applyStyleToWidget widget "cursor: auto;"++-- | Курсор auto+cursorCrosshair :: WidgetUI -> UI WidgetUI+cursorCrosshair widget = applyStyleToWidget widget "cursor: crosshair;"++-- | Курсор default+cursorDefault :: WidgetUI -> UI WidgetUI+cursorDefault  widget = applyStyleToWidget widget "cursor: default;"++-- | Курсор e-resize+cursorEResize :: WidgetUI -> UI WidgetUI+cursorEResize  widget = applyStyleToWidget widget "cursor: e-resize;"++-- | Курсор help+cursorHelp :: WidgetUI -> UI WidgetUI+cursorHelp widget = applyStyleToWidget widget "cursor: help;"++-- | Курсор move+cursorMove :: WidgetUI -> UI WidgetUI+cursorMove widget = applyStyleToWidget widget "cursor: move;"++-- | Курсор n-resize+cursorNResize :: WidgetUI -> UI WidgetUI+cursorNResize widget = applyStyleToWidget widget "cursor: n-resize;"++-- | Курсор ne-resize+cursorNEResize :: WidgetUI -> UI WidgetUI+cursorNEResize widget = applyStyleToWidget widget "cursor: ne-resize;"++-- | Курсор nw-resize+cursorNWResize :: WidgetUI -> UI WidgetUI+cursorNWResize widget = applyStyleToWidget widget "cursor: nw-resize;"++-- | Курсор pointer+cursorPointer :: WidgetUI -> UI WidgetUI+cursorPointer widget = applyStyleToWidget widget "cursor: pointer;"++-- | Курсор progress+cursorProgress :: WidgetUI -> UI WidgetUI+cursorProgress widget = applyStyleToWidget widget "cursor: progress;"++-- | Курсор s-resize+cursorSResize :: WidgetUI -> UI WidgetUI+cursorSResize widget = applyStyleToWidget widget "cursor: s-resize;"++-- | Курсор se-resize+cursorSEResize :: WidgetUI -> UI WidgetUI+cursorSEResize widget = applyStyleToWidget widget "cursor: se-resize;"++-- | Курсор sw-resize+cursorSWResize :: WidgetUI -> UI WidgetUI+cursorSWResize widget = applyStyleToWidget widget "cursor: sw-resize;"++-- | Курсор text+cursorText :: WidgetUI -> UI WidgetUI+cursorText widget = applyStyleToWidget widget "cursor: text;"++-- | Курсор w-resize+cursorWResize :: WidgetUI -> UI WidgetUI+cursorWResize widget = applyStyleToWidget widget "cursor: w-resize;"++-- | Курсор wait+cursorWait :: WidgetUI -> UI WidgetUI+cursorWait widget = applyStyleToWidget widget "cursor: wait;"++-- | Курсор auto+cursorInherit :: WidgetUI -> UI WidgetUI+cursorInherit widget = applyStyleToWidget widget "cursor: inherit;"++-- | Курсор по изображению+cursorImage :: UIImage -> WidgetUI -> UI WidgetUI+cursorImage image widget = applyStyleToWidget widget ("cursor: " ++ (show image) ++ ";")++++-- | Отображение содержимого auto+overflowAuto :: WidgetUI -> UI WidgetUI+overflowAuto widget = applyStyleToWidget widget "overflow: auto;"++-- | Отображение содержимого hidden+overflowHidden :: WidgetUI -> UI WidgetUI+overflowHidden widget = applyStyleToWidget widget "overflow: hidden;"++-- | Отображение содержимого scroll+overflowScroll :: WidgetUI -> UI WidgetUI+overflowScroll widget = applyStyleToWidget widget "overflow: scroll;"++-- | Отображение содержимого visible+overflowVisible :: WidgetUI -> UI WidgetUI+overflowVisible widget = applyStyleToWidget widget "overflow: visible;"++-- | Отображение содержимого inherit+overflowInherit :: WidgetUI -> UI WidgetUI+overflowInherit widget = applyStyleToWidget widget "overflow: inherit;"++++-- | Отображение содержимого X auto+overflowAutoX :: WidgetUI -> UI WidgetUI+overflowAutoX widget = applyStyleToWidget widget "overflow-x: auto;"++-- | Отображение содержимого X hidden+overflowHiddenX :: WidgetUI -> UI WidgetUI+overflowHiddenX widget = applyStyleToWidget widget "overflow-x: hidden;"++-- | Отображение содержимого X scroll+overflowScrollX :: WidgetUI -> UI WidgetUI+overflowScrollX widget = applyStyleToWidget widget "overflow-x: scroll;"++-- | Отображение содержимого X visible+overflowVisibleX :: WidgetUI -> UI WidgetUI+overflowVisibleX widget = applyStyleToWidget widget "overflow-x: visible;"++-- | Отображение содержимого X inherit+overflowInheritX :: WidgetUI -> UI WidgetUI+overflowInheritX widget = applyStyleToWidget widget "overflow-x: inherit;"++++-- | Отображение содержимого Y auto+overflowAutoY :: WidgetUI -> UI WidgetUI+overflowAutoY widget = applyStyleToWidget widget "overflow-y: auto;"++-- | Отображение содержимого Y hidden+overflowHiddenY :: WidgetUI -> UI WidgetUI+overflowHiddenY widget = applyStyleToWidget widget "overflow-y: hidden;"++-- | Отображение содержимого Y scroll+overflowScrollY :: WidgetUI -> UI WidgetUI+overflowScrollY widget = applyStyleToWidget widget "overflow-y: scroll;"++-- | Отображение содержимого Y visible+overflowVisibleY :: WidgetUI -> UI WidgetUI+overflowVisibleY widget = applyStyleToWidget widget "overflow-y: visible;"++-- | Отображение содержимого Y inherit+overflowInheritY :: WidgetUI -> UI WidgetUI+overflowInheritY widget = applyStyleToWidget widget "overflow-y: inherit;"++++-- | Данные повторения фона+data BGRepeat = BGNoRepeat | BGRepeat | BGRepeatX | BGRepeatY | BGInherit | BGSpace | BGRound++instance Show BGRepeat where+    show BGNoRepeat = "no-repeat"+    show BGRepeat   = "repeat"+    show BGRepeatX  = "repeat-x"+    show BGRepeatY  = "repeat-y"+    show BGInherit  = "inherit"+    show BGSpace    = "space"+    show BGRound    = "round"++-- | Данные прокрутки фона+data BGAttachment = BGAFixed | BGAScroll | BGAInherit | BGALocal++instance Show BGAttachment where+    show BGAFixed   = "fixed"+    show BGAScroll  = "scroll"+    show BGAInherit = "inherit"+    show BGALocal   = "local"++data BGSize = BGSize HSize+            | BGAuto+            | BGCover +            | BGContain++instance Show BGSize where+    show (BGSize s) = show s+    show BGAuto     = "auto"+    show BGCover    = "cover"+    show BGContain  = "contain"++-- | Дозаполняем атрибуты для background+instance CArgumentableAttr (UIColor -> UIImage -> UIPosition -> BGRepeat -> BGAttachment -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a thC_Or ImageEmpty UIInherit BGNoRepeat BGAFixed+instance CArgumentableAttr (           UIImage -> UIPosition -> BGRepeat -> BGAttachment -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a        ImageEmpty UIInherit BGNoRepeat BGAFixed+instance CArgumentableAttr (                      UIPosition -> BGRepeat -> BGAttachment -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a                   UIInherit BGNoRepeat BGAFixed+instance CArgumentableAttr (                                    BGRepeat -> BGAttachment -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a                             BGNoRepeat BGAFixed+instance CArgumentableAttr (                                                BGAttachment -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a                                        BGAFixed+++-- | Фон+background :: UIColor -> UIImage -> UIPosition -> BGRepeat -> BGAttachment -> WidgetUI -> UI WidgetUI+background color image position repeat attachment widget = do+    w1 <- backgroundColor      color      widget+    w2 <- backgroundImage      image      w1+    w3 <- backgroundPosition   position   w2+    w4 <- backgroundRepeat     repeat     w3+    w5 <- backgroundAttachment attachment w4+    return w5++-- | Цвет фона+backgroundColor :: UIColor -> WidgetUI -> UI WidgetUI+backgroundColor color widget = applyStyleToWidget widget ("background-color: " ++ color ++ ";")++-- | Положение фона+backgroundPosition :: UIPosition -> WidgetUI -> UI WidgetUI+backgroundPosition position widget = applyStyleToWidget widget ("background-position: " ++ (show position) ++ ";")++-- | Повторение фона+backgroundRepeat :: BGRepeat -> WidgetUI -> UI WidgetUI+backgroundRepeat repeat widget = applyStyleToWidget widget ("background-repeat: " ++ (show repeat) ++ ";")++-- | Прокрутка фона+backgroundAttachment :: BGAttachment -> WidgetUI -> UI WidgetUI+backgroundAttachment attachment widget =  applyStyleToWidget widget ("background-attachment: " ++ (show attachment) ++ ";")++-- | Изображение фона по URL+backgroundImage :: UIImage -> WidgetUI -> UI WidgetUI+backgroundImage image widget = applyStyleToWidget widget ("background-image: " ++ (show image) ++ ";")++-- | Масштабирует фоновое изображения+backgroundSize :: BGSize -> WidgetUI -> UI WidgetUI+backgroundSize bgSize widget = applyStyleToWidget widget ("background-size: " ++ (show bgSize) ++ ";")+++-- | Данные стиля рамки+data BorderStyle = BSNotDefined | BSNone | BSHidden | BSDotted | BSDashed | BSSolid | BSDouble | BSGroove | BSRidge | BSInset | BSOutset | BSInherit+instance Show BorderStyle where+    show BSNotDefined   = ""+    show BSNone         = "none"+    show BSHidden       = "hidden" +    show BSDotted       = "dotted" +    show BSDashed       = "dashed" +    show BSSolid        = "solid" +    show BSDouble       = "double" +    show BSGroove       = "groove" +    show BSRidge        = "ridge" +    show BSInset        = "inset" +    show BSOutset       = "outset"+    show BSInherit      = "inherit"++++-- | Дозаполняем атрибуты для border+instance CArgumentableAttr (Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a 1 BSSolid thC_Or +instance CArgumentableAttr (       BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a   BSSolid thC_Or +instance CArgumentableAttr (                      UIColor -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a           thC_Or ++++-- | Рамка border+border :: Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI+border  = applyBorderToWidget "border"++-- | Рамка border-left+border_left :: Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI+border_left  = applyBorderToWidget "border-left"++-- | Рамка border-right+border_right :: Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI+border_right  = applyBorderToWidget "border-right"++-- | Рамка border-top+border_top :: Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI+border_top  = applyBorderToWidget "border-top"++-- | Рамка border-bottom+border_bottom :: Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI+border_bottom  = applyBorderToWidget "border-bottom"++-- | Вспомогательный метод для применения рамки к элементу+applyBorderToWidget :: String -> Int -> BorderStyle -> UIColor -> WidgetUI -> UI WidgetUI+applyBorderToWidget preffix width borderStyle color widget = applyStyleToWidget widget (preffix ++ ": " ++ (show width) ++ "px " ++ (show borderStyle) ++ " " ++ color  ++ ";")++-- | Рамка borderNone+borderNone :: WidgetUI -> UI WidgetUI+borderNone = applyBorderNoneToWidget "border"++-- | Рамка border-leftNone+border_leftNone :: WidgetUI -> UI WidgetUI+border_leftNone = applyBorderNoneToWidget "border-left"++-- | Рамка border-rightNone+border_rightNone :: WidgetUI -> UI WidgetUI+border_rightNone = applyBorderNoneToWidget "border-right"++-- | Рамка border-topNone+border_topNone :: WidgetUI -> UI WidgetUI+border_topNone = applyBorderNoneToWidget "border-top"++-- | Рамка border-bottomNone+border_bottomNone :: WidgetUI -> UI WidgetUI+border_bottomNone = applyBorderNoneToWidget "border-bottom"++-- | Вспомогательный метод для применения рамки None к элементу+applyBorderNoneToWidget :: String -> WidgetUI -> UI WidgetUI+applyBorderNoneToWidget preffix widget = applyStyleToWidget widget (preffix ++ ": " ++ (show 0) ++ "px " ++ (show BSNone) ++ ";")++++-- | Радиус рамки+borderRadius :: CSizeable a => (a, a, a, a) -> WidgetUI -> UI WidgetUI+borderRadius (r1, r2, r3, r4) widget =+    applyStyleToWidget widget ("border-radius:" ++ (showSize r1) ++ " " ++ (showSize r2) ++ " " ++ (showSize r3) ++ " " ++ (showSize r4) ++ ";")++-- | Радиус рамки (Num)+borderRadiusNum :: (Int, Int, Int, Int) -> WidgetUI -> UI WidgetUI+borderRadiusNum (r1, r2, r3, r4) widget =+    applyStyleToWidget widget ("border-radius:" ++ (show r1) ++ "px " ++ (show r2) ++ "px " ++ (show r3) ++ "px " ++ (show r4) ++ "px;")++-- | Радиус рамки  (Str)+borderRadiusStr :: (String, String, String, String) -> WidgetUI -> UI WidgetUI+borderRadiusStr (r1, r2, r3, r4) widget =+    applyStyleToWidget widget ("border-radius:" ++ r1 ++ " " ++ r2 ++ " " ++ r3 ++ " " ++ r4 ++ ";")+++-- | Радиус рамки (Ext)+borderRadiusExt ::(HSize, HSize, HSize, HSize) -> WidgetUI -> UI WidgetUI+borderRadiusExt (r1, r2, r3, r4) widget =+    applyStyleToWidget widget ("border-radius:" ++ (showSize r1) ++ " " ++ (showSize r2) ++ " " ++ (showSize r3) ++ " " ++ (showSize r4) ++ ";")++++-- | Тип точки отчсета для систем координат+data UI_StartingPoint = UI_Default+                      | UI_LT    +                      | UI_RT    +                      | UI_RB    +                      | UI_LB    +                      | UI_Top   +                      | UI_Bottom+                      deriving Show++data HSize = HN Int +           | HP String+           | HJ Int +           | HD Double +           | HL String+           deriving Show++class Show a => CSizeable a where+    showSize :: a -> String++instance CSizeable HSize where+    showSize (HN a) = (show a) ++ "px"+    showSize (HP a) = if '%' `elem` a then a else (a ++ "%")+    showSize (HJ a) = (show a) ++ "%"+    showSize (HD a) = (show a) ++ "%"+    showSize (HL a) = a++instance CSizeable Int where+    showSize a = (show a) ++ "px"+        +instance CSizeable String where+    showSize a = if '%' `elem` a then a else (a ++ "%")++{-+type USize = forall a . Num a => a++t1 :: USize+t1 = 10++t2 :: USize+t2 = "asasas"+++instance Num String where+    x + y = x ++ y +    x - y = x ++ y +    x * y = x ++ y +    negate x = x+    abs x = x+    signum x = x+    fromInteger x = show x++instance Data.String.IsString USize where+    fromString _ = 0+-}+++-- | Дозаполняем атрибуты для bounds+instance CArgumentableAttr ((Int   , Int   , Int   , Int)    -> UI_StartingPoint -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (0   , 0   , 100   , 50   ) UI_LT +instance CArgumentableAttr ((String, String, String, String) -> UI_StartingPoint -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a ("0%", "0%", "50%" , "50%") UI_LT +instance CArgumentableAttr ((HSize , HSize , HSize , HSize)  -> UI_StartingPoint -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (HN 0, HN 0, HN 100, HN 50) UI_LT +--instance (Num b, CSizeable b) => CArgumentableAttr ((b, b, b, b) -> UI_StartingPoint -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (0, 0, 100, 50) UI_LT +instance CArgumentableAttr (                                    UI_StartingPoint -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a                             UI_LT +++-- | Разместить виджет (Ext)+bounds :: CSizeable a => (a, a, a, a) -> UI_StartingPoint -> WidgetUI -> UI WidgetUI+bounds (x, y, width, height) startingPoint widget =+    case startingPoint of +        UI_LT -> applyStyleToWidget widget ("left:"  ++ (showSize x) ++ ";top:"    ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        UI_RT -> applyStyleToWidget widget ("right:" ++ (showSize x) ++ ";top:"    ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        UI_RB -> applyStyleToWidget widget ("right:" ++ (showSize x) ++ ";bottom:" ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        UI_LB -> applyStyleToWidget widget ("left:"  ++ (showSize x) ++ ";bottom:" ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        _     -> applyStyleToWidget widget ("left:"  ++ (showSize x) ++ ";top:"    ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+++-- | Разместить виджет (Num)+boundsNum :: (Int, Int, Int, Int) -> UI_StartingPoint -> WidgetUI -> UI WidgetUI+boundsNum (x, y, width, height) startingPoint widget =+    case startingPoint of +        UI_LT -> applyStyleToWidget widget ("left:"  ++ (show x) ++ "px;top:"    ++ (show y) ++ "px;width:" ++ (show width) ++ "px;height:" ++ (show height) ++ "px;")+        UI_RT -> applyStyleToWidget widget ("right:" ++ (show x) ++ "px;top:"    ++ (show y) ++ "px;width:" ++ (show width) ++ "px;height:" ++ (show height) ++ "px;")+        UI_RB -> applyStyleToWidget widget ("right:" ++ (show x) ++ "px;bottom:" ++ (show y) ++ "px;width:" ++ (show width) ++ "px;height:" ++ (show height) ++ "px;")+        UI_LB -> applyStyleToWidget widget ("left:"  ++ (show x) ++ "px;bottom:" ++ (show y) ++ "px;width:" ++ (show width) ++ "px;height:" ++ (show height) ++ "px;")+        _     -> applyStyleToWidget widget ("left:"  ++ (show x) ++ "px;top:"    ++ (show y) ++ "px;width:" ++ (show width) ++ "px;height:" ++ (show height) ++ "px;")++                  +-- | Разместить виджет (Str)+boundsStr :: (String, String, String, String) -> UI_StartingPoint -> WidgetUI -> UI WidgetUI+boundsStr (x, y, width, height) startingPoint widget =+    case startingPoint of +        UI_LT -> applyStyleToWidget widget ("left:"  ++ x ++ ";top:"    ++ y ++ ";width:" ++ width ++ ";height:" ++ height ++ ";")+        UI_RT -> applyStyleToWidget widget ("right:" ++ x ++ ";top:"    ++ y ++ ";width:" ++ width ++ ";height:" ++ height ++ ";")+        UI_RB -> applyStyleToWidget widget ("right:" ++ x ++ ";bottom:" ++ y ++ ";width:" ++ width ++ ";height:" ++ height ++ ";")+        UI_LB -> applyStyleToWidget widget ("left:"  ++ x ++ ";bottom:" ++ y ++ ";width:" ++ width ++ ";height:" ++ height ++ ";")+        _     -> applyStyleToWidget widget ("left:"  ++ x ++ ";top:"    ++ y ++ ";width:" ++ width ++ ";height:" ++ height ++ ";")++++-- | Разместить виджет (Ext)+boundsExt :: (HSize, HSize, HSize, HSize) -> UI_StartingPoint -> WidgetUI -> UI WidgetUI+boundsExt (x, y, width, height) startingPoint widget =+    case startingPoint of +        UI_LT -> applyStyleToWidget widget ("left:"  ++ (showSize x) ++ ";top:"    ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        UI_RT -> applyStyleToWidget widget ("right:" ++ (showSize x) ++ ";top:"    ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        UI_RB -> applyStyleToWidget widget ("right:" ++ (showSize x) ++ ";bottom:" ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        UI_LB -> applyStyleToWidget widget ("left:"  ++ (showSize x) ++ ";bottom:" ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+        _     -> applyStyleToWidget widget ("left:"  ++ (showSize x) ++ ";top:"    ++ (showSize y) ++ ";width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")++++-- | Разместить виджет по отступам от граней+boundsBRD :: CSizeable a => (a, a, a, a) -> WidgetUI -> UI WidgetUI+boundsBRD (top, right, bottom, left) widget =+    applyStyleToWidget widget ("top:" ++ (showSize top) ++ ";right:" ++ (showSize right) ++ ";bottom:" ++ (showSize bottom) ++ ";left:" ++ (showSize left) ++ ";")+++-- | Разместить виджет по отступам от граней+boundsBRDNum :: (Int, Int, Int, Int) -> WidgetUI -> UI WidgetUI+boundsBRDNum (top, right, bottom, left) widget =+    applyStyleToWidget widget ("top:" ++ (show top) ++ "px;right:" ++ (show right) ++ "px;bottom:" ++ (show bottom) ++ "px;left:" ++ (show left) ++ "px;")+++-- | Разместить виджет по отступам от граней (Str)+boundsBRDStr :: (String, String, String, String) -> WidgetUI -> UI WidgetUI+boundsBRDStr (top, right, bottom, left) widget =+    applyStyleToWidget widget ("top:" ++ top ++ ";right:" ++ right ++ ";bottom:" ++ bottom ++ ";left:" ++ left ++ ";")+++-- | Разместить виджет по отступам от граней (Ext)+boundsBRDExt ::(HSize, HSize, HSize, HSize) -> WidgetUI -> UI WidgetUI+boundsBRDExt (top, right, bottom, left) widget =+    applyStyleToWidget widget ("top:" ++ (showSize top) ++ ";right:" ++ (showSize right) ++ ";bottom:" ++ (showSize bottom) ++ ";left:" ++ (showSize left) ++ ";")++++-- | Ширина+wwidth :: CSizeable a => a -> WidgetUI -> UI WidgetUI+wwidth val widget =+    applyStyleToWidget widget ("width:" ++ (showSize val) ++ ";")++-- | Ширина (Num)+widthNum :: Int -> WidgetUI -> UI WidgetUI+widthNum val widget =+    applyStyleToWidget widget ("width:" ++ (show val) ++ "px;")++-- | Ширина (Str)+widthStr :: String -> WidgetUI -> UI WidgetUI+widthStr val widget =+    applyStyleToWidget widget ("width:" ++ val ++ ";")++-- | Ширина (Ext)+widthExt :: HSize -> WidgetUI -> UI WidgetUI+widthExt val widget =+    applyStyleToWidget widget ("width:" ++ (showSize val) ++ ";")++++-- | Ширина Min+wwidthMin :: CSizeable a => a -> WidgetUI -> UI WidgetUI+wwidthMin val widget =+    applyStyleToWidget widget ("min-width:" ++ (showSize val) ++ ";")++-- | Ширина Min (Num)+widthMinNum :: Int -> WidgetUI -> UI WidgetUI+widthMinNum val widget =+    applyStyleToWidget widget ("min-width:" ++ (show val) ++ "px;")++-- | Ширина Min (Str)+widthMinStr :: String -> WidgetUI -> UI WidgetUI+widthMinStr val widget =+    applyStyleToWidget widget ("min-width:" ++ val ++ ";")++-- | Ширина Min (Ext)+widthMinExt :: HSize -> WidgetUI -> UI WidgetUI+widthMinExt val widget =+    applyStyleToWidget widget ("min-width:" ++ (showSize val) ++ ";")++++-- | Ширина Max+wwidthMax :: CSizeable a => a -> WidgetUI -> UI WidgetUI+wwidthMax val widget =+    applyStyleToWidget widget ("max-width:" ++ (showSize val) ++ ";")++-- | Ширина Max (Num)+widthMaxNum :: Int -> WidgetUI -> UI WidgetUI+widthMaxNum val widget =+    applyStyleToWidget widget ("max-width:" ++ (show val) ++ "px;")++-- | Ширина Max (Str)+widthMaxStr :: String -> WidgetUI -> UI WidgetUI+widthMaxStr val widget =+    applyStyleToWidget widget ("max-width:" ++ val ++ ";")++-- | Ширина Max (Ext)+widthMaxExt :: HSize -> WidgetUI -> UI WidgetUI+widthMaxExt val widget =+    applyStyleToWidget widget ("max-width:" ++ (showSize val) ++ ";")++++-- | Высота+wheight :: CSizeable a => a -> WidgetUI -> UI WidgetUI+wheight val widget =+    applyStyleToWidget widget ("height:" ++ (showSize val) ++ ";")++-- | Высота (Num)+heightNum :: Int -> WidgetUI -> UI WidgetUI+heightNum val widget =+    applyStyleToWidget widget ("height:" ++ (show val) ++ "px;")++-- | Высота (Str)+heightStr :: String -> WidgetUI -> UI WidgetUI+heightStr val widget =+    applyStyleToWidget widget ("height:" ++ val ++ ";")++-- | Высота (Ext)+heightExt :: HSize -> WidgetUI -> UI WidgetUI+heightExt val widget =+    applyStyleToWidget widget ("height:" ++ (showSize val) ++ ";")++++-- | Высота Min+wheightMin :: CSizeable a => a -> WidgetUI -> UI WidgetUI+wheightMin val widget =+    applyStyleToWidget widget ("min-height:" ++ (showSize val) ++ ";")++-- | Высота Min (Num)+heightMinNum :: Int -> WidgetUI -> UI WidgetUI+heightMinNum val widget =+    applyStyleToWidget widget ("min-height:" ++ (show val) ++ "px;")++-- | Высота Min (Str)+heightMinStr :: String -> WidgetUI -> UI WidgetUI+heightMinStr val widget =+    applyStyleToWidget widget ("min-height:" ++ val ++ ";")++-- | Высота Min (Ext)+heightMinExt :: HSize -> WidgetUI -> UI WidgetUI+heightMinExt val widget =+    applyStyleToWidget widget ("min-height:" ++ (showSize val) ++ ";")++++-- | Высота Max+wheightMax :: CSizeable a => a -> WidgetUI -> UI WidgetUI+wheightMax val widget =+    applyStyleToWidget widget ("max-height:" ++ (showSize val) ++ ";")++-- | Высота Max (Num)+heightMaxNum :: Int -> WidgetUI -> UI WidgetUI+heightMaxNum val widget =+    applyStyleToWidget widget ("max-height:" ++ (show val) ++ "px;")++-- | Высота Max (Str)+heightMaxStr :: String -> WidgetUI -> UI WidgetUI+heightMaxStr val widget =+    applyStyleToWidget widget ("max-height:" ++ val ++ ";")++-- | Высота Max (Ext)+heightMaxExt :: HSize -> WidgetUI -> UI WidgetUI+heightMaxExt val widget =+    applyStyleToWidget widget ("max-height:" ++ (showSize val) ++ ";")++++-- | Дозаполняем атрибуты для size+instance CArgumentableAttr ((Int   , Int   ) -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (50   , 50   ) +instance CArgumentableAttr ((String, String) -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a ("50%", "50%") +instance CArgumentableAttr ((HSize , HSize ) -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (HN 50, HN 50) +++-- | Размер виджета +wsize :: CSizeable a => (a, a) -> WidgetUI -> UI WidgetUI+wsize (width, height) widget =+    applyStyleToWidget widget ("width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")+++-- | Размер виджета (Num)+sizeNum :: (Int, Int) -> WidgetUI -> UI WidgetUI+sizeNum (width, height) widget =+    applyStyleToWidget widget ("width:" ++ (show width) ++ "px;height:" ++ (show height) ++ "px;")++                  +-- | Размер виджета (Str)+sizeStr :: (String, String) -> WidgetUI -> UI WidgetUI+sizeStr (width, height) widget =+    applyStyleToWidget widget ("width:" ++ width ++ ";height:" ++ height ++ ";")+++-- | Размер виджета (Ext)+sizeExt :: (HSize, HSize) -> WidgetUI -> UI WidgetUI+sizeExt (width, height) widget =+    applyStyleToWidget widget ("width:" ++ (showSize width) ++ ";height:" ++ (showSize height) ++ ";")++++-- | Дозаполняем атрибуты для margin+instance CArgumentableAttr ((Int   , Int   , Int   , Int)    -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (5   , 5   , 5   , 5   )  +instance CArgumentableAttr ((String, String, String, String) -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a ("0%", "0%", "0%", "0%")  +instance CArgumentableAttr ((HSize , HSize , HSize , HSize)  -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (HN 5, HN 5, HN 5, HN 5)  +++-- | Внешние отступы виджета+margin :: CSizeable a => (a, a, a, a) -> WidgetUI -> UI WidgetUI+margin (l, t, r, b) widget =+    applyStyleToWidget widget ("margin-left:" ++ (showSize l) ++ ";margin-top:" ++ (showSize t) ++ ";margin-right:" ++ (showSize r) ++ ";margin-bottom:" ++ (showSize b) ++ ";")+++-- | Внешние отступы виджета (Num)+marginNum :: (Int, Int, Int, Int) -> WidgetUI -> UI WidgetUI+marginNum (l, t, r, b) widget =+    applyStyleToWidget widget ("margin-left:" ++ (show l) ++ "px;margin-top:" ++ (show t) ++ "px;margin-right:" ++ (show r) ++ "px;margin-bottom:" ++ (show b) ++ "px;")+                  ++-- | Внещние отступы виджета (Str)+marginStr :: (String, String, String, String) -> WidgetUI -> UI WidgetUI+marginStr (l, t, r, b) widget =+    applyStyleToWidget widget ("margin-left:" ++ l ++ ";margin-top:" ++  t ++ ";margin-right:" ++ r ++ ";margin-bottom:" ++ b ++ ";")+++-- | Внешние отступы виджета (Ext)+marginExt :: (HSize, HSize, HSize, HSize) -> WidgetUI -> UI WidgetUI+marginExt (l, t, r, b) widget =+    applyStyleToWidget widget ("margin-left:" ++ (showSize l) ++ ";margin-top:" ++ (showSize t) ++ ";margin-right:" ++ (showSize r) ++ ";margin-bottom:" ++ (showSize b) ++ ";")++++-- | Внешние отступы виджета Left+marginLeft :: CSizeable a => a -> WidgetUI -> UI WidgetUI+marginLeft l widget =+    applyStyleToWidget widget ("margin-left:" ++ (showSize l) ++ ";")+++-- | Внешние отступы виджета Left (Num)+marginLeftNum :: Int -> WidgetUI -> UI WidgetUI+marginLeftNum l widget =+    applyStyleToWidget widget ("margin-left:" ++ (show l) ++ "px;")+                  ++-- | Внещние отступы виджета Left (Str)+marginLeftStr :: String -> WidgetUI -> UI WidgetUI+marginLeftStr l widget =+    applyStyleToWidget widget ("margin-left:" ++ l ++ ";")+++-- | Внешние отступы виджета Left (Ext)+marginLeftExt :: HSize -> WidgetUI -> UI WidgetUI+marginLeftExt l widget =+    applyStyleToWidget widget ("margin-left:" ++ (showSize l) ++ ";")++++-- | Внешние отступы виджета Right+marginRight :: CSizeable a => a -> WidgetUI -> UI WidgetUI+marginRight r widget =+    applyStyleToWidget widget ("margin-right:" ++ (showSize r) ++ ";")+++-- | Внешние отступы виджета Right (Num)+marginRightNum :: Int -> WidgetUI -> UI WidgetUI+marginRightNum r widget =+    applyStyleToWidget widget ("margin-right:" ++ (show r) ++ "px;")+                  ++-- | Внещние отступы виджета Right (Str)+marginRightStr :: String -> WidgetUI -> UI WidgetUI+marginRightStr r widget =+    applyStyleToWidget widget ("margin-right:" ++ r ++ ";")+++-- | Внешние отступы виджета Right (Ext)+marginRightExt :: HSize -> WidgetUI -> UI WidgetUI+marginRightExt r widget =+    applyStyleToWidget widget ("margin-right:" ++ (showSize r) ++ ";")++++-- | Внешние отступы виджета Top+marginTop :: CSizeable a => a -> WidgetUI -> UI WidgetUI+marginTop t widget =+    applyStyleToWidget widget ("margin-top:" ++ (showSize t) ++ ";")+++-- | Внешние отступы виджета Top (Num)+marginTopNum :: Int -> WidgetUI -> UI WidgetUI+marginTopNum t widget =+    applyStyleToWidget widget ("margin-top:" ++ (show t) ++ "px;")+                  ++-- | Внещние отступы виджета Top (Str)+marginTopStr :: String -> WidgetUI -> UI WidgetUI+marginTopStr t widget =+    applyStyleToWidget widget ("margin-top:" ++  t ++ ";")+++-- | Внешние отступы виджета Top (Ext)+marginTopExt :: HSize -> WidgetUI -> UI WidgetUI+marginTopExt t widget =+    applyStyleToWidget widget ("margin-top:" ++ (showSize t) ++ ";")++++-- | Внешние отступы виджета Bottom+marginBottom :: CSizeable a => a -> WidgetUI -> UI WidgetUI+marginBottom b widget =+    applyStyleToWidget widget ("margin-bottom:" ++ (showSize b) ++ ";")+++-- | Внешние отступы виджета Bottom (Num)+marginBottomNum :: Int -> WidgetUI -> UI WidgetUI+marginBottomNum b widget =+    applyStyleToWidget widget ("margin-bottom:" ++ (show b) ++ "px;")+                  ++-- | Внещние отступы виджета Top (Str)+marginBottomStr :: String -> WidgetUI -> UI WidgetUI+marginBottomStr b widget =+    applyStyleToWidget widget ("margin-bottom:" ++ b ++ ";")+++-- | Внешние отступы виджета Top (Ext)+marginBottomExt :: HSize -> WidgetUI -> UI WidgetUI+marginBottomExt b widget =+    applyStyleToWidget widget ("margin-bottom:" ++ (showSize b) ++ ";")++++-- | Все внешние отступы виджета+marginAll :: CSizeable a => a -> WidgetUI -> UI WidgetUI+marginAll val = margin (val, val, val, val)++-- | Все внешние отступы виджета (Num)+marginAllNum :: Int -> WidgetUI -> UI WidgetUI+marginAllNum val = marginNum (val, val, val, val)++-- | Все внешние отступы виджета (Str)+marginAllStr :: String -> WidgetUI -> UI WidgetUI+marginAllStr val = marginStr (val, val, val, val)++-- | Все внешние отступы виджета (Ext)+marginAllExt :: HSize -> WidgetUI -> UI WidgetUI+marginAllExt val = marginExt (val, val, val, val)++++-- | Внутренние отступы виджета+padding :: CSizeable a => (a, a, a, a) -> WidgetUI -> UI WidgetUI+padding (l, t, r, b) widget =+    applyStyleToWidget widget ("padding-left:" ++ (showSize l) ++ ";padding-top:" ++ (showSize t) ++ ";padding-right:" ++ (showSize r) ++ ";padding-bottom:" ++ (showSize b) ++ ";")+++-- | Внутренние отступы виджета (Num)+paddingNum :: (Int, Int, Int, Int) -> WidgetUI -> UI WidgetUI+paddingNum (l, t, r, b) widget =+    applyStyleToWidget widget ("padding-left:" ++ (show l) ++ "px;padding-top:" ++ (show t) ++ "px;padding-right:" ++ (show r) ++ "px;padding-bottom:" ++ (show b) ++ "px;")+                  ++-- | Внутренние отступы виджета (Str)+paddingStr :: (String, String, String, String) -> WidgetUI -> UI WidgetUI+paddingStr (l, t, r, b) widget =+    applyStyleToWidget widget ("padding-left:" ++ l ++ ";padding-top:" ++  t ++ ";padding-right:" ++ r ++ ";padding-bottom:" ++ b ++ ";")+++-- | Внутренние отступы виджета (Ext)+paddingExt :: (HSize, HSize, HSize, HSize) -> WidgetUI -> UI WidgetUI+paddingExt (l, t, r, b) widget =+    applyStyleToWidget widget ("padding-left:" ++ (showSize l) ++ ";padding-top:" ++ (showSize t) ++ ";padding-right:" ++ (showSize r) ++ ";padding-bottom:" ++ (showSize b) ++ ";")++++-- | Внутренние отступы виджета Left+paddingLeft :: CSizeable a => a -> WidgetUI -> UI WidgetUI+paddingLeft l widget =+    applyStyleToWidget widget ("padding-left:" ++ (showSize l) ++ ";")+++-- | Внутренние отступы виджета Left (Num)+paddingLeftNum :: Int -> WidgetUI -> UI WidgetUI+paddingLeftNum l widget =+    applyStyleToWidget widget ("padding-left:" ++ (show l) ++ "px;")+                  ++-- | Внутренние отступы виджета Left (Str)+paddingLeftStr :: String -> WidgetUI -> UI WidgetUI+paddingLeftStr l widget =+    applyStyleToWidget widget ("padding-left:" ++ l ++ ";")+++-- | Внутренние отступы виджета Left (Ext)+paddingLeftExt :: HSize -> WidgetUI -> UI WidgetUI+paddingLeftExt l widget =+    applyStyleToWidget widget ("padding-left:" ++ (showSize l) ++ ";")++++-- | Внутренние отступы виджета Right+paddingRight :: CSizeable a => a -> WidgetUI -> UI WidgetUI+paddingRight r widget =+    applyStyleToWidget widget ("padding-right:" ++ (showSize r) ++ ";")+++-- | Внутренние отступы виджета Right (Num)+paddingRightNum :: Int -> WidgetUI -> UI WidgetUI+paddingRightNum r widget =+    applyStyleToWidget widget ("padding-right:" ++ (show r) ++ "px;")+                  ++-- | Внутренние отступы виджета Right (Str)+paddingRightStr :: String -> WidgetUI -> UI WidgetUI+paddingRightStr r widget =+    applyStyleToWidget widget ("padding-right:" ++ r ++ ";")+++-- | Внутренние отступы виджета Right (Ext)+paddingRightExt :: HSize -> WidgetUI -> UI WidgetUI+paddingRightExt r widget =+    applyStyleToWidget widget ("padding-right:" ++ (showSize r) ++ ";")++++-- | Внутренние отступы виджета Top+paddingTop :: CSizeable a => a -> WidgetUI -> UI WidgetUI+paddingTop t widget =+    applyStyleToWidget widget ("padding-top:" ++ (showSize t) ++ ";")+++-- | Внутренние отступы виджета Top (Num)+paddingTopNum :: Int -> WidgetUI -> UI WidgetUI+paddingTopNum t widget =+    applyStyleToWidget widget ("padding-top:" ++ (show t) ++ "px;")+                  ++-- | Внутренние отступы виджета Top (Str)+paddingTopStr :: String -> WidgetUI -> UI WidgetUI+paddingTopStr t widget =+    applyStyleToWidget widget ("padding-top:" ++  t ++ ";")+++-- | Внутренние отступы виджета Top (Ext)+paddingTopExt :: HSize -> WidgetUI -> UI WidgetUI+paddingTopExt t widget =+    applyStyleToWidget widget ("padding-top:" ++ (showSize t) ++ ";")++++-- | Внутренние отступы виджета Bottom+paddingBottom :: CSizeable a => a -> WidgetUI -> UI WidgetUI+paddingBottom b widget =+    applyStyleToWidget widget ("padding-bottom:" ++ (showSize b) ++ ";")+++-- | Внутренние отступы виджета Bottom (Num)+paddingBottomNum :: Int -> WidgetUI -> UI WidgetUI+paddingBottomNum b widget =+    applyStyleToWidget widget ("padding-bottom:" ++ (show b) ++ "px;")+                  ++-- | Внутренние отступы виджета Top (Str)+paddingBottomStr :: String -> WidgetUI -> UI WidgetUI+paddingBottomStr b widget =+    applyStyleToWidget widget ("padding-bottom:" ++ b ++ ";")+++-- | Внутренние отступы виджета Top (Ext)+paddingBottomExt :: HSize -> WidgetUI -> UI WidgetUI+paddingBottomExt b widget =+    applyStyleToWidget widget ("padding-bottom:" ++ (showSize b) ++ ";")++++-- | Все внутренние отступы виджета+paddingAll :: CSizeable a => a -> WidgetUI -> UI WidgetUI+paddingAll val = padding (val, val, val, val)++-- | Все внутренние отступы виджета (Num)+paddingAllNum :: Int -> WidgetUI -> UI WidgetUI+paddingAllNum val = paddingNum (val, val, val, val)++-- | Все внутренние отступы виджета (Str)+paddingAllStr :: String -> WidgetUI -> UI WidgetUI+paddingAllStr val = paddingStr (val, val, val, val)++-- | Все внутренние отступы виджета (Ext)+paddingAllExt :: HSize -> WidgetUI -> UI WidgetUI+paddingAllExt val = paddingExt (val, val, val, val)++++-- | Дозаполняем атрибуты left+--instance CArgumentableAttr ((CSizeable a => a) -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a 0 ++-- | Отступ слева+left :: CSizeable a => a -> WidgetUI -> UI WidgetUI+left val widget =+    applyStyleToWidget widget ("left:" ++ (showSize val) ++ ";")++-- | Отступ слева (Num)+leftNum :: Int -> WidgetUI -> UI WidgetUI+leftNum val widget =+    applyStyleToWidget widget ("left:" ++ (show val) ++ "px;")++-- | Отступ слева (Str)+leftStr :: String -> WidgetUI -> UI WidgetUI+leftStr val widget =+    applyStyleToWidget widget ("left:" ++ val ++ ";")++-- | Отступ слева (Ext)+leftExt :: HSize -> WidgetUI -> UI WidgetUI+leftExt val widget =+    applyStyleToWidget widget ("left:" ++ (showSize val) ++ ";")++++-- | Отступ справа+right :: CSizeable a => a -> WidgetUI -> UI WidgetUI+right val widget =+    applyStyleToWidget widget ("right:" ++ (showSize val) ++ ";")++-- | Отступ справа (Num)+rightNum :: Int -> WidgetUI -> UI WidgetUI+rightNum val widget =+    applyStyleToWidget widget ("right:" ++ (show val) ++ "px;")++-- | Отступ справа (Str)+rightStr :: String -> WidgetUI -> UI WidgetUI+rightStr val widget =+    applyStyleToWidget widget ("right:" ++ val ++ ";")++-- | Отступ справа (Ext)+rightExt :: HSize -> WidgetUI -> UI WidgetUI+rightExt val widget =+    applyStyleToWidget widget ("right:" ++ (showSize val) ++ ";")++++-- | Отступ сверху+top :: CSizeable a => a -> WidgetUI -> UI WidgetUI+top val widget =+    applyStyleToWidget widget ("top:" ++ (showSize val) ++ ";")++-- | Отступ сверху (Num)+topNum :: Int -> WidgetUI -> UI WidgetUI+topNum val widget =+    applyStyleToWidget widget ("top:" ++ (show val) ++ "px;")++-- | Отступ сверху (Str)+topStr :: String -> WidgetUI -> UI WidgetUI+topStr val widget =+    applyStyleToWidget widget ("top:" ++ val ++ ";")++-- | Отступ сверху (Ext)+topExt :: HSize -> WidgetUI -> UI WidgetUI+topExt val widget =+    applyStyleToWidget widget ("top:" ++ (showSize val) ++ ";")++++-- | Отступ снизу+bottom :: CSizeable a => a -> WidgetUI -> UI WidgetUI+bottom val widget =+    applyStyleToWidget widget ("bottom:" ++ (showSize val) ++ ";")++-- | Отступ снизу (Num)+bottomNum :: Int -> WidgetUI -> UI WidgetUI+bottomNum val widget =+    applyStyleToWidget widget ("bottom:" ++ (show val) ++ "px;")++-- | Отступ снизу (Str)+bottomStr :: String -> WidgetUI -> UI WidgetUI+bottomStr val widget =+    applyStyleToWidget widget ("bottom:" ++ val ++ ";")++-- | Отступ снизу (Ext)+bottomExt :: HSize -> WidgetUI -> UI WidgetUI+bottomExt val widget =+    applyStyleToWidget widget ("bottom:" ++ (showSize val) ++ ";")++++-- | Установка foreground (цвет текста)+foreground :: UIColor -> WidgetUI -> UI WidgetUI+foreground color widget =+    applyStyleToWidget widget ("color:" ++ color ++ ";")++++-- | Установка fill (цвет залтвки SVG)+fill :: UIColor -> WidgetUI -> UI WidgetUI+fill color widget =+    applyStyleToWidget widget ("fill:" ++ color ++ ";")++++-- | Тип семейства шрифта+data FFamily = FFM String++instance Show FFamily where+    show (FFM a) = a+++-- | Тип размера шрифта+data FSize = FSizePt Double | FSizeEm Double | FSizeEx Double | HSize deriving Show++instance CSizeable FSize where+    showSize (FSizePt a) = (show a) ++ "pt"+    showSize (FSizeEm a) = (show a) ++ "em"+    showSize (FSizeEx a) = (show a) ++ "ex"+    showSize a = showSize a+++-- | Тип стиля шрифта+data FontStyle = FNormal | FItalic | FOblique | FInherit+instance Show FontStyle where+    show FNormal    = "normal"+    show FItalic    = "italic"+    show FOblique   = "oblique"+    show FInherit   = "inherit"+++-- | Тип насыщенности шрифта+data FontWeight = FWBold +                | FWBolder +                | FWLighter +                | FWNormal +                | FW100 +                | FW200 +                | FW300 +                | FW400 +                | FW500 +                | FW600 +                | FW700 +                | FW800 +                | FW900++instance Show FontWeight where+    show FWBold     = "bold"+    show FWBolder   = "bolder"+    show FWLighter  = "lighter"+    show FWNormal   = "normal"+    show FW100      = "100"+    show FW200      = "200"+    show FW300      = "300"+    show FW400      = "400"+    show FW500      = "500"+    show FW600      = "600"+    show FW700      = "700"+    show FW800      = "800"+    show FW900      = "900"+++-- | Тип шрифта+data UIFont = UIFont FFamily FSize FontStyle FontWeight ++instance Show UIFont where+    show (UIFont family size style weight) =  +                                             (show                style ) ++ " " +++                                             (show                weight) ++ " " +++                                             (showSize            size  ) ++ " " ++ +                                             (wrappInSingleQuotes . show $ family)++ffSerif     = FFM "serif"+ffSansSerif = FFM "sans-serif"+ffCursive   = FFM "cursive"+ffFantasy   = FFM "fantasy"+ffMonospace = FFM "monospace"+++-- | Дозаполняем атрибуты для font+instance CArgumentableAttr (UIFont     -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (UIFont ffSansSerif (FSizeEm 1) FNormal FWNormal)+instance CArgumentableAttr (FFamily    -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a ffSansSerif+instance CArgumentableAttr (FSize      -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a (FSizeEm 1)+instance CArgumentableAttr (FontStyle  -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a FNormal+instance CArgumentableAttr (FontWeight -> WidgetUI -> UI WidgetUI) where expressArgumentAttr a = a FWNormal+++-- | Установить шрифт+font :: UIFont -> WidgetUI -> UI WidgetUI+font f widget = +    applyStyleToWidget widget ("font:" ++ (show f) ++ ";")+++-- | Установить семейства шрифтов+fontFamily :: FFamily -> WidgetUI -> UI WidgetUI+fontFamily family widget =+    applyStyleToWidget widget ("font-family:" ++ (show family) ++ ";")+++-- | Установить семейства шрифтов+fontSize :: FSize -> WidgetUI -> UI WidgetUI+fontSize size widget =+    applyStyleToWidget widget ("font-size:" ++ (showSize size) ++ ";")+++-- | Установить семейства шрифтов+fontStyle :: FontStyle -> WidgetUI -> UI WidgetUI+fontStyle style widget =+    applyStyleToWidget widget ("font-style:" ++ (show style) ++ ";")+++-- | Установить насыщенность шрифтов+fontWeight :: FontWeight -> WidgetUI -> UI WidgetUI+fontWeight weight widget =+    applyStyleToWidget widget ("font-weight:" ++ (show weight) ++ ";")++++-- | Установка ZIndex+zIndex :: Int -> WidgetUI -> UI WidgetUI+zIndex val widget =+    applyStyleToWidget widget ("z-index:" ++ (show val) ++ ";")++++-- | Применить класс к виджету+classToWidget :: String -> WidgetUI -> UI WidgetUI+classToWidget text widget = applyClassToWidget widget (text ++ " ")++++-- | Применить стиля к виджету+styleToWidget :: String -> WidgetUI -> UI WidgetUI+styleToWidget text widget = applyStyleToWidget widget text++++-- | Всплывающая подсказка+tooltip :: String -> WidgetUI -> UI WidgetUI+tooltip text widget = do+    case wui_element widget of+        EmptyElementUI  -> return widget+        ElementUI a     -> return widget { wui_element = ElementUI   (a ! HA.title (toAttrVal text)) }+        ContainerUI b   -> return widget { wui_element = ContainerUI (b ! HA.title (toAttrVal text)) }++++-- | Действие в сценарии hover+--hover :: CArgumentableAttr a => (UI WidgetUI -> a -> UI WidgetUI) -> WidgetUI -> UI WidgetUI+hover :: WidgetUI -> WidgetUI -> UI WidgetUI+hover sample widget = do+    className <- return $ "hfc_" ++ generateUUID_+    return widget { wui_styles = (wui_styles widget) ++ [H.style $ toHtml ("." ++ className ++ ":hover {" ++ (wui_attr_style sample) ++ "}" )] +                  , wui_attr_class = (wui_attr_class widget) ++ " " ++ className+                  }++-- | Действие в сценарии hover (в монаде UI)+hoverm :: UI WidgetUI -> WidgetUI -> UI WidgetUI+hoverm samplem widget = do+    sample <- samplem+    className <- return $ "hfc_" ++ generateUUID_+    return widget { wui_styles = (wui_styles widget) ++ [H.style $ toHtml ("." ++ className ++ ":hover {" ++ (wui_attr_style sample) ++ "}" )] +                  , wui_attr_class = (wui_attr_class widget) ++ " " ++ className+                  }++++-- | Обернуть текст в одинарные кавычки+wrappInSingleQuotes :: String -> String+wrappInSingleQuotes text = "'" ++ text ++ "'"++++-- | Вспомогательный метод для применения класса к элементу+applyClassToWidget :: WidgetUI -> String -> UI WidgetUI+applyClassToWidget widget text = do return widget { wui_attr_class = (wui_attr_class widget) ++ " " ++ text }++++-- | Вспомогательный метод для применения стиля к элементу+applyStyleToWidget :: WidgetUI -> String -> UI WidgetUI+applyStyleToWidget widget text = do return widget { wui_attr_style = (wui_attr_style widget) ++ text }++++-- | Подготовка HTML из String+--prepareHTML c = TB.string c+++-- | Подготовка CSS+prepareCSS a = toHtml $ renderCssUrl undefined a+++-- | Подготовка JavaScript+prepareJS b = toHtml $ renderJavascriptUrl undefined b++++++-----------------------------------------------------------------------------------------------+-- Виджеты UI   -------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------++-- | Начало цепочки виджетов+shellUI :: H.Html +        -> UI WidgetUI +shellUI title = do+    widgetThis <- defaultWidgetUI+    return $ widgetThis { wui_title = title }++++-- | Начало цепочки виджетов с расширениями+shellExtUI :: H.Html +           -> [(WidgetUI -> UI WidgetUI)]+           -> UI WidgetUI +shellExtUI title exts = do+    shell <- shellUI title+    recExt shell exts+    where recExt :: WidgetUI -> [(WidgetUI -> UI WidgetUI)] -> UI WidgetUI+          recExt shell [] = do return shell+          recExt shell (x:xs) = do +            sh <- requare shell x +            recExt sh xs+              +++-- | Элемент (Element)+wuiElement :: UI WidgetUI+wuiElement = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "element"+    where+        elem = ContainerUI $ H.div ++wuiElement_ = unsafePerformUI $ wuiElement+{-# DEPRECATED wuiElement_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Виджет элемента из HTML+wuiHTML :: H.Html+        -> UI WidgetUI+wuiHTML v = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "wui_html"+    where+        elem = ElementUI $ H.span $ do v++wuiHTML_ = unsafePerformUI . wuiHTML+{-# DEPRECATED wuiHTML_ "This is unsafe! It is not recommended to use this function!" #-}++++-- | Виджет скриптов Src +wuiScriptSrc :: [String]+            -> UI WidgetUI+wuiScriptSrc array = do+    uuid <- generateUUID+    widget <- return $ createWidgetUI elem uuid "script_src"+    recwsrc widget array+    where+        elem = EmptyElementUI +        recwsrc :: WidgetUI -> [String] -> UI WidgetUI+        recwsrc w [] = do return w+        recwsrc w (x:xs) = do+            wd <- return $ w { wui_scripts = (wui_scripts w) ++ [H.script ! src (toAttrVal x) $ ""] }+            recwsrc wd xs++++-- | Виджет скриптов Src +wuiStyleHref :: [String]+            -> UI WidgetUI+wuiStyleHref array = do+    uuid <- generateUUID+    widget <- return $ createWidgetUI elem uuid "style_href"+    recwstl widget array+    where+        elem = EmptyElementUI +        recwstl :: WidgetUI -> [String] -> UI WidgetUI+        recwstl w [] = do return w+        recwstl w (x:xs) = do+            wd <- return $ w { wui_styles = (wui_styles w) ++ [ H.link ! rel "stylesheet" ! type_ "text/css" ! href (toAttrVal x)] }+            recwstl wd xs++++-- | Виджет скрипта JS+wuiScriptJS :: JavascriptUrl b +            -> UI WidgetUI+wuiScriptJS js = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "script"+    where+        elem = ElementUI $ H.script ! type_ "text/javascript" $ do prepareJS js++++-- | Виджет скриптов JS+wuiScriptJSs :: [JavascriptUrl b]+            -> UI WidgetUI+wuiScriptJSs jsArray = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "script"+    where+        elem = ElementUI $ H.script ! type_ "text/javascript" $ do mapM_ prepareJS jsArray++++-- | Виджет скрипта JS+wuiScriptTextJS :: String +            -> UI WidgetUI+wuiScriptTextJS tjs = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "script_text"+    where+        elem = ElementUI $ H.script ! type_ "text/javascript" $ toHtml tjs++++-- | Виджет скриптов JS+wuiScriptTextJSs :: [String]+            -> UI WidgetUI+wuiScriptTextJSs tjsArray = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "script_text"+    where+        elem = ElementUI $ H.script ! type_ "text/javascript" $ do mapM_ (toHtml) tjsArray++++-- | Виджет каскадных таблиц стилей CSS+wuiCSS :: CssUrl a+       -> UI WidgetUI+wuiCSS css = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "css"+    where+        elem = ElementUI $ H.style $ do prepareCSS css++++-- | Виджет каскадных таблиц стилей CSS+wuiCSSs :: [CssUrl a]+        -> UI WidgetUI+wuiCSSs cssArray = do+    uuid <- generateUUID+    return $ createWidgetUI elem uuid "css"+    where+        elem = ElementUI $ H.style $ do mapM_ prepareCSS cssArray+++++

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"