ExistentialQuantification example

Main.hs

-- in reply to http://www.reddit.com/r/haskell/comments/1zf3ay/trying_to_design_a_gui_library/

{-# LANGUAGE ExistentialQuantification #-}

import Text.Printf


type Key = String

data Widget s = Widget
   { handleKey :: Key -> s -> s
   , draw :: Int -> Int -> s -> IO ()  -- s was missing
   , getFocus :: s -> s
   , loseFocus :: s -> s
   -- more methods may be added in the future
   }


data AnyWidget = forall s. AnyWidget
   { methods :: Widget s
   , currentState :: s
   }

handleKey' :: Key -> AnyWidget -> AnyWidget
handleKey' k (AnyWidget m s) = AnyWidget m (handleKey m k s)

draw' :: Int -> Int -> AnyWidget -> IO ()
draw' x y (AnyWidget m s) = draw m x y s

getFocus' :: AnyWidget -> AnyWidget
getFocus' (AnyWidget m s) = AnyWidget m (getFocus m s)

loseFocus' :: AnyWidget -> AnyWidget
loseFocus' (AnyWidget m s) = AnyWidget m (loseFocus m s)


type Radius = Int

circle :: Widget Radius
circle = Widget
    { handleKey = \_ -> (+1)
    , draw = printf "circle (%d, %d) %d\n"
    , getFocus = (*2)
    , loseFocus = (`div` 2)
    }


type Size = (Int, Int)

rect :: Widget Size
rect = Widget
    { handleKey = \_ (w, h) -> (w+1, h)
    , draw = \x y (w, h) -> printf "rect (%d, %d) (%d, %d)\n" x y w h
    , getFocus = \(w, h) -> (w, h*2)
    , loseFocus = \(w, h) -> (w, h `div` 2)
    }


widgets :: [AnyWidget]
widgets = [AnyWidget circle 10, AnyWidget rect (15, 5)]


main = do
    printf "initial state:\n"
    let ws0 = widgets
    mapM_ (draw' 0 0) ws0
    
    printf "\npressing <up arrow>:\n"
    let ws1 = map (handleKey' "up") ws0
    mapM_ (draw' 0 0) ws1
    
    printf "\nfocus on first widget:\n"
    let [c,r] = ws1
    let c' = getFocus' c
    let r' = r
    mapM_ (draw' 0 0) [c',r']
    
    printf "\nfocus on second widget:\n"
    let c'' = loseFocus' c'
    let r'' = getFocus' r'
    mapM_ (draw' 0 0) [c'',r'']