MissingDollars.hs

import Control.Monad
import Safe

import Paths

import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core

{-----------------------------------------------------------------------------
    Missing Dollars
------------------------------------------------------------------------------}
main :: IO ()
main = do
    static <- getStaticDir
    startGUI defaultConfig
        { tpPort       = 10000
        , tpStatic     = Just static
        } setup


setup :: Window -> UI ()
setup w = void $ do
    return w # set title "Missing Dollars"
    UI.addStyleSheet w "missing-dollars.css"
    
    (headerView,headerMe) <- mkHeader
    riddle                <- mkMissingDollarRiddle headerMe
    let layout = [element headerView] ++ riddle ++ attributionSource        
    getBody w #+ [UI.div #. "wrap" #+ layout]


mkHeader :: UI (Element, Element)
mkHeader = do
    headerMe <- string "..."
    view     <- UI.h1   #+ [string "The ", element headerMe, string " Dollars"]
    return (view, headerMe)

attributionSource :: [UI Element]
attributionSource =
    [ UI.p #+
        [ UI.anchor #. "view-source" # set UI.href urlSource
            #+ [string "View source code"]
        ]
    , UI.p #+
        [ string "Originally by "
        , UI.anchor # set UI.href urlAttribution #+ [string "Albert Lai"]
        ]
    ]
  where
    urlSource      = "https://github.com/HeinrichApfelmus/threepenny-gui/blob/master/src/MissingDollars.hs"
    urlAttribution = "http://www.vex.net/~trebla/humour/missing_dollar.html"


mkMissingDollarRiddle :: Element -> UI [UI Element]
mkMissingDollarRiddle headerMe = do
    -- declare input and display values
    (hotelOut : hotelCost : hotelHold : _)
        <- sequence . replicate 3 $
            UI.input # set (attr "size") "3" # set (attr "type") "text"

    (hotelChange : hotelRet     : hotelBal : hotelPocket :
     hotelBal2   : hotelPocket2 : hotelSum : hotelMe     : _)
        <- sequence . replicate 8 $ UI.span
    
    -- update procedure
    let updateDisplay out cost hold = do
        let change = out - cost
            ret    = change - hold
            bal    = out - ret
            sum    = bal + hold
            diff   = sum - out
        element hotelOut     # set value (show out)
        element hotelCost    # set value (show cost)
        element hotelHold    # set value (show hold)
        element hotelChange  # set text  (show change)
        element hotelRet     # set text  (show ret)
        element hotelBal     # set text  (show bal)
        element hotelPocket  # set text  (show hold)
        element hotelBal2    # set text  (show bal)
        element hotelPocket2 # set text  (show hold)
        element hotelSum     # set text  (show sum)
        
        if diff >= 0
           then do element hotelMe  # set text ("extra $" ++ show diff ++ " come from")
                   element headerMe # set text "Extra"
           else do element hotelMe  # set text ("missing $" ++ show (-diff) ++ " go")
                   element headerMe # set text "Missing"
        return ()
    
    -- initialize values
    updateDisplay 30 25 2
    
    -- calculate button
    calculate <- UI.button #+ [string "Calculate"]
    on UI.click calculate $ \_ -> do
        result <- mapM readMay `liftM` getValuesList [hotelOut,hotelCost,hotelHold]
        case result of
            Just [getout,getcost,gethold] -> updateDisplay getout getcost gethold
            _ -> return ()
    
    return $
        [ UI.h2 #+ [string "The Guests, The Bellhop, And The Pizza"]
        , UI.p  #+
            [ string "Three guests went to a hotel and gave $"
            , element hotelOut
            , string " to the bellhop to buy pizza. The pizza cost only $"
            , element hotelCost
            , string ". Of the $"
            , element hotelChange
            , string " change, the bellhop kept $"
            , element hotelHold
            , string " to himself and returned $"
            , element hotelRet
            , string " to the guests."
            ]
        , UI.p  #+
            [ string "So the guests spent $"
            , element hotelBal
            , string ", and the bellhop pocketed $"
            , element hotelPocket
            , string ". Now "
            , string "$"
            , element hotelBal2
            , string "+$"
            , element hotelPocket2
            , string "=$"
            , element hotelSum
            , string ". Where did the "
            , element hotelMe
            , string "?"
            ]
        , element calculate
        ]