Threepenny GUI's

HSE.hs

{-# LANGUAGE RecursiveDo #-}

module Main(main) where

import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core
import Graphics.UI.Threepenny.Editors
import Data.Profunctor

import Language.Haskell.Exts
import Control.Monad
import Data.Maybe


{-----------------------------------------------------------------------------
    Main
------------------------------------------------------------------------------}
main :: IO ()
main = startGUI defaultConfig setup

example = unlines
    ["module Main(main) where"
    ,""
    ,"main :: IO ()"
    ,"main = putStrLn \"Hello World!\""
    ]


parser :: ParseMode -> String -> String
parser mode x = case parseFileContentsWithMode mode x of
    ParseOk x -> show $ fmap (const ()) x
    x@ParseFailed{} -> show x


pMode :: UI (Element, Behavior ParseMode)
pMode = do
    filename <- UI.input
    language <- UI.select
        #+ [UI.option # set text (show x) | x <- knownLanguages]
        # set UI.selection (Just 0)
    ignore <- UI.input # set (attr "type") "checkbox"

    layout <- grid
        [[string "Filename", element filename]
        ,[string "Language", element language]
        ,[string "Ignore pragmas", element ignore]]

    filename <- stepper "" $ UI.valueChange filename
    language <- fmap (fmap ((!!) knownLanguages . fromMaybe 0)) $ stepper Nothing $ UI.selectionChange language
    ignore <- stepper False $ UI.checkedChange ignore

    let val = (\f l i -> defaultParseMode{parseFilename=f, baseLanguage=l, ignoreLanguagePragmas=i}) <$>
            filename <*> language <*> ignore
    return (layout, val)

instance Editable Language where
    editor = dimap Just (fromMaybe $ head knownLanguages) $
        editorSelection (pure knownLanguages) (pure (string . show))

pMode2 :: UI (Element, Behavior ParseMode)
pMode2 = mdo
    let ed = (\f l i -> defaultParseMode{parseFilename=f, baseLanguage=l, ignoreLanguagePragmas=i})
            <$> field "Filename" parseFilename editor
            -*- field "Language" baseLanguage editor
            -*- field "Ignore pragmas" ignoreLanguagePragmas editor
    parseModeE <- createEditor ed parseModeB
    parseModeB <- stepper defaultParseMode (edited parseModeE)
    return (editorElement parseModeE, parseModeB)

setup :: Window -> UI ()
setup window = void $ do
    return window # set title "HSE parser"
    mode <- pMode2

    source <- UI.textarea
        # set UI.style [("width","600px"),("height","250px")]
        # set value example
    sourceVal <- stepper example $ UI.valueChange source

    output <- UI.textarea
        # set UI.style [("width","600px"),("height","250px")]
        # set (attr "readonly") "readonly"
        # sink value (parser <$> snd mode <*> sourceVal)

    getBody window #+ [row [column [element source, element output], element $ fst mode]]

This builds for me with threepenny-editors-0.5.0, it should work fine with earlier versions as well:

pModeEditor :: EditorFactory ParseMode Layout ParseMode
pModeEditor =
  (\f l i  -> defaultParseMode{parseFilename=f, baseLanguage=l, ignoreLanguagePragmas=i})
    <$> field "Filename" parseFilename editor
    -*- field "Language" baseLanguage (editorJust editorReadShow)
    -*- field "Ignore pragmas" ignoreLanguagePragmas editor

pMode' :: UI (Element, Behavior ParseMode)
pMode' = mdo
  parseModeB <- stepper defaultParseMode (edited parseModeE)
  parseModeE <- createEditor pModeEditor parseModeB
  return (_editorElement parseModeE, parseModeB)

Changed to use an editorSelection for the language.

pModeEditor :: EditorFactory ParseMode Layout ParseMode
pModeEditor =
  (\f l i  -> defaultParseMode{parseFilename=f, baseLanguage=l, ignoreLanguagePragmas=i})
    <$> field "Filename" parseFilename editor
    -*- field "Language" baseLanguage (editorJust $ editorSelection (pure knownLanguages) (pure (string . show)))
    -*- field "Ignore pragmas" ignoreLanguagePragmas editor

We also need to flip the order of the stepper and createEditor commands to avoid a recursive loop, this is a known baffling threepenny issue:

pMode' :: UI (Element, Behavior ParseMode)
pMode' = mdo
  parseModeE <- createEditor pModeEditor parseModeB
  parseModeB <- stepper defaultParseMode (edited parseModeE)
  return (_editorElement parseModeE, parseModeB)

I got 90% of the way there. The "mistakes" I made where:

• I used label instead of string, which resulted in nothing showing up in the combobox, and no type error or anything. A bit sad.
• I passed pure defaultParseMode into createEditor, and then hoped it would return the edited parse mode. It didn't. It seems that createEditor could have a more magic version which takes an initial value, and returns a Behaviour which is the result. Although that may well be a lack of understanding on my part.

Oh, and I wrote my own editorJust by hand.