Делаю GUI на Haskell

mkExampleWidgetHelloWorld :: WidgetInit SimpleWidget
mkExampleWidgetHelloWorld = mkSimpleWidget (WidgetMarginXY 20 10) $ defNoChildrenFns{
        onCreate = (\widget -> notifyParentOnSizeChangedAndMarkForRedraw widget $ V2 0 80)
        ,onDraw=drawFn}
    where drawFn widget canvas = do
                canvasRect <- getCanvasRect widget
                setColor canvas $ V4 0 0 255 0
                fillRect canvas canvasRect
                setColor canvas $ V4 255 0 0 0
                drawRect canvas $ shrinkRect' 5 canvasRect
                fnt <- getFont canvas ""
                drawStrAligned canvas fnt AlignCenter DrawStrFine (V4 255 255 255 0) canvasRect 
                                             "Привет, мир!"
 
mkExampleWidgetPicture :: WidgetInit SimpleWidget
mkExampleWidgetPicture = mkSimpleWidget (WidgetMarginXY 20 10) $ defNoChildrenFns{
        onCreate = (\widget -> notifyParentOnSizeChangedAndMarkForRedraw widget $ V2 0 160)
        ,onDraw=(\widget canvas -> do
                    canvasRect <- getCanvasRect widget
                    drawStretchedTextureR canvas "snapshot_00.41.57.jpg" Nothing canvasRect
                )}
 
mkExampleTextGrid :: WidgetInit SimpleWidget
mkExampleTextGrid = mkSimpleWidget (WidgetMarginXY 20 10) $ defNoChildrenFns{
        onCreate = (\widget -> notifyParentOnSizeChangedAndMarkForRedraw widget $ V2 0 (-1))
        ,onDraw=drawFn}
  where drawFn widget canvas = do
            canvasRect@(   SDL.Rectangle (P (V2 l t)) (V2 w h)) <- getCanvasRect widget
            setColor canvas $ grayColor 200
            fillRect canvas canvasRect
            fnt <- getFont canvas ""
            let dx = 30
                dy = 20
                txtColor = (V4 0 100 0 0)
                txtFill r y =
                    let txtRow c x = when (x < w) $ do
                                drawStr canvas fnt txtColor (P (V2 x y)) [c,r]
                                txtRow (succ c) (x+dx)
                    in when (y < h) $ do
                        txtRow '0' l
                        txtFill (succ r) (y+dy)
            txtFill '0' t
 
main :: IO ()
main = runGUI defSkin [GuiFontDef "" "PTM55F.ttf" 14] $ \gui _ -> do
    win <- newWindow gui "GUI : vertical layout test" $ 
                       SDL.defaultWindow { SDL.windowInitialSize = V2 300 400 }
    vLayout <- (win $+) =<< mkVLayout WidgetMarginNone zero (grayColor 230)
    mapM_ (vLayout $+) [mkExampleWidgetHelloWorld, mkExampleWidgetPicture, mkExampleTextGrid]

-- Простенький виджет, что бы показать как это делается.
framesTest :: MonadIO m => Widget -> Skin -> m (GuiWidget SimpleWidget)
framesTest parent Skin{..} = mkSimpleWidget (WidgetMarginXY 20 10) parent (defNoChildrenFns $ V2 250 80){
            onDraw= \ widget -> do
                visibleRect@( SDL.Rectangle p0 _) <- getVisibleRect widget
                setColor bkColor
                fillRect visibleRect
                let rect0 = SDL.Rectangle (p0 .+^ V2 10 10)  (V2 50 50)
                    ligthColor = grayColor 240
                    darkColor = grayColor 180
                draw3DBorder ligthColor darkColor 1 rect0
                draw3DBorder ligthColor darkColor 2 $ rectMove rect0 (V2 70 0)
                setColor $ grayColor 0
                drawRoundBorder $ rectMove rect0 (V2 140 0)
            }
 
main :: IO ()
main = runGUI defSkin
     -- Таблица предзагруженных шрифтов : ключ, имя файла, размер шрифта
        [GuiFontDef ""          "PTM55F.ttf" 14
        ,GuiFontDef "label"     "PTN57F.ttf" 15]
        $ \gui -> do
    win <- newWindow gui "GUI test" $ SDL.defaultWindow { SDL.windowInitialSize = V2 400 400
                                                        --, SDL.windowResizable = True
                                                        }
 
    vL <- win $+ vLayout def{layoutAlignment = AlignCenterTop}
 
    ~[hL0,hL1,hL2,hL3,hL4] <- replicateM 5 (vL $+ hLayout def)
    void $ hL0 $+ label def{labelSize=V2 200 20, labelAlignment=AlignCenter,
                          labelText="Рамки элементов интерфейса :"}
    void $ hL1 $+ framesTest
    lb0 <- hL2 $+ label def{labelSize=V2 70 20, labelAlignment=AlignLeftCenter,
                          labelText="Трекбар :"}
    trBar <- hL2 $+ linearTrackBarTest def{
                               linearTrackBarLn = 200
                             , linearTrackBarMargin = WidgetMarginXY 10 0
                             , linearTrackMinValue = 0
                             , linearTrackMaxValue = 1000
                             , linearTrackBarPos  = 300
                                          }
    let btTriangleDef = ButtonWithTriangleDef   { btTriangleFormItemDef = FormItemWidgetDef $ Just $
                                                                            WidgetMarginXY 3 0
                                                , btTriangleFlags = WidgetVisible .|. WidgetEnable
                                                , btTriangleOrientation = OrientationLeft
                                                , btTriangleSize = V2 16 16
                                                , btTriangleType = ButtonWithTriangleInForm
                                                }
    btnL <- hL2 $+ buttonWithTriangle btTriangleDef
    btnR <- hL2 $+ buttonWithTriangle btTriangleDef{btTriangleOrientation = OrientationRight}
    btnU <- hL2 $+ buttonWithTriangle btTriangleDef{btTriangleOrientation = OrientationUp}
    btnD <- hL2 $+ buttonWithTriangle btTriangleDef{btTriangleOrientation = OrientationDown}
    lb1 <- hL3 $+ label def{labelSize=V2 250 80, labelWrapMode= TextWrap 0 Nothing, labelAlignment=AlignCenter,
        labelText=
        "Пример текста, который может переходить на другие строки, таким образом образуя многострочный текст."}
    btn1 <- hL4 $+ button def{btnSize = V2 120 120,  btnPicture = ButtonLeftPicture "sync.png"
                , btnTextWrapMode = TextWrap 0 Nothing
                , btnText = "Кнопка с картинкой слева и текстом в несколько строк"  }
    btn2 <- hL4 $+ button def{btnSize = V2 120 120,  btnPicture = ButtonBottomPicture "check.png"
                , btnTextWrapMode = TextWrap 0 Nothing
                , btnText = "Кнопка с картинкой внизу и текстом в несколько строк"  }
    btn3 <- hL4 $+ button def{btnSize = V2 120 120,  btnPicture = ButtonBottomPicture "rss_circle.png"
                , btnTextWrapMode = TextWrap 0 Nothing
                , btnText = "Эту кнопку сделаем недоступной после нажатия первой"  }
    -- Реакции на события
    onClick btn1 $ do -- Переводим 3-ю кнопку в disable
        let widget = getWidget btn3
        widgetFlagsRemove widget WidgetEnable
        markWidgetForRedraw widget
    onClick btn2 $ do -- Переводим 3-ю кнопку в enable
        let widget = getWidget btn3
        widgetFlagsAdd widget WidgetEnable
        markWidgetForRedraw widget
    onClick btn3 $ setValue trBar (500::Int) -- устанавливаем scrollBar на середину
    -- при перетаскивании scrollBar-а соответствующее значение отображается в тексте метки
    onChanged trBar $ \ v -> setText lb1 (T.pack $ show (v:: Int))
    -- При нажатии на кнопки со стрелками цвет текста "Трекбар :" поменяется
    onClick btnL $ setTextColor lb0 $ rgb 255 0 0
    onClick btnR $ setTextColor lb0 $ rgb 0 255 0
    onClick btnU $ setTextColor lb0 $ rgb 0 0 255
    onClick btnD $ setTextColor lb0 $ rgb 0 0 0

    lb <- win $+ label def{labelAlignment=AlignCenter
                           , labelFormItemDef= FormItemWidgetDef $ Just WidgetMarginNone
                           , labelText= "Через 2 с здесь будут данные из трэда"}
 
    pipe <- newGuiPipe gui $ \ _ v -> do
        let toText ix = T.pack $ show $ v V.! ix
        setText lb $ T.concat ["Разрешение дисплея ", toText 0,"x",toText 1]
 
    void $ forkIO $ do
        threadDelay 2000000
        (V2 xRes yRes) <- (SDL.displayBoundsSize . head) <$> SDL.getDisplays
        void $ sendToGuiPipe pipe $ V.singleton xRes `V.snoc` yRes

    vL <- win $+ vLayout def{layoutAlignment = AlignCenterTop}
 
    -- Define actions
    addActions gui "File" [
         ("New",def{actionText="Новый", actionHotKey=hkCtrl SDL.KeycodeN, actionPicture="new.ico"})
        ,("Open",def{actionText="Открыть", actionHotKey=hkCtrl SDL.KeycodeO, actionPicture="open.png"})
        ,("Save",def{actionText="Сохранить", actionHotKey=hkCtrl SDL.KeycodeS, actionPicture="save.png"})
        ,("SaveAs",def{actionText="Сохранить как", actionPicture="saveas.png"})]
 
    addActions gui "Edit" [
         ("Cut",def{actionText="Вырезать", actionHotKey=hkCtrl SDL.KeycodeX, actionPicture="cut.png"})
        ,("Copy",def{actionText="Копировать", actionHotKey=hkCtrl SDL.KeycodeC, actionPicture="copy.png"})
        ,("Paste",def{actionText="Вставить", actionHotKey=hkCtrl SDL.KeycodeV, actionPicture="paste.png"})]
 
    addActions gui "Application" [
         ("Exit",def{actionText="Выход", actionHotKey=hkAlt SDL.KeycodeF4, actionPicture="exit.png"
            , actionValue = def{onAction=guiApplicationExitSuccess gui}})]
 
    addActions gui "Find" [
         ("Find",def{actionText="Поиск"})
        ,("Replace",def{actionText="Замена"})
         ]
 
    addActions gui "FileFind" [
         ("Find",def{actionText="Поиск в файлах"})
        ,("Replace",def{actionText="Замена в файлах"})
         ]
 
    addActions gui "doSubmenu" [
         ("SomeSubmenu",def{actionText="Некое подменю"})
         ]
 
    addActions gui "ExamplSub" [
         ("Item 1",def{actionText="Действие 1"})
        ,("Item 2",def{actionText="Действие 2"})
        ,("Item 3",def{actionText="Действие 3"})
         ]
 
    -- Define popup menus
    let popupFile = mkMenu (mItem "File" "New") (mItem "File" "Open") (mItem "File" "Save") (mItem "File" "SaveAs")
                           (mItemSub "doSubmenu" "SomeSubmenu" $ mkMenu (mItem "ExamplSub" "Item 1")
                                                                        (mItem "ExamplSub" "Item 2")
                                                                        (mItem "ExamplSub" "Item 3"))
                           (mItem    "Application" "Exit")
        popupEdit = mkMenu (mItem "Edit" "Cut") (mItem "Edit" "Copy") (mItem "Edit" "Paste")
        popupFind = mkMenu (mItem "Find" "Find") (mItem "Find" "Replace")
                           (mItem "FileFind" "Find") (mItem "FileFind" "Replace")
 
    void $ vL $+ horizontalMenu def{hmenuItems = mkHMenu
        def{hmenuText = "Файл", hmenuPopup = popupFile}
        def{hmenuText = "Правка", hmenuPopup = popupEdit}
        def{hmenuText = "Поиск", hmenuPopup = popupFind}
                                    }
 
    void $ vL $+ border def { borderFormItemDef = FormItemWidgetDef $ Just WidgetMarginNone
                            , borderSize = V2 (-1) 2, borderType = BorderMono
                            , borderBkgrnd = BorderBkColor $ grayColor 255
                            }
 
    let txtHotKeyPrompt = "Попробуйте нажать Alt-F2 или Ctrl-D"
    lb <- vL $+ label def{labelSize=V2 (-1) 20, labelAlignment=AlignCenter, labelText=txtHotKeyPrompt}
 
    hL0 <- vL $+ hLayout def
    btn0 <- hL0 $+ button def{btnSize = V2 200 35, btnText = "Восстановить текст"}
    onClick btn0 $ do
        setText lb txtHotKeyPrompt
        
    addActions gui "Hotkeys" [
         ("hk0",def{actionHotKey= hkAlt SDL.KeycodeF2, actionValue=def{onAction= setText lb "Alt-F2"}})
        ,("hk1",def{actionHotKey= hkCtrl SDL.KeycodeD, actionValue=def{onAction= setText lb "Ctrl-D"}})
        ]
 
    -- Пример задания/замены действия для Action после его создания.
    setAction gui "File" "Save" $ setText lb "Нажат пункт меню File/Save"