LayoutBase.hs

----------------------------------------------------------------
-- Модуль приложения
-- Графический интерфейс (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