GuiTV-0.4: src/Examples.hs

{-# LANGUAGE OverlappingInstances, UndecidableInstances
           , IncoherentInstances, FlexibleContexts
           , TypeSynonymInstances, FlexibleInstances
           , MultiParamTypeClasses
           #-}
-- For ghc 6.6 compatibility
-- {-# OPTIONS -fglasgow-exts -fallow-overlapping-instances -fallow-incoherent-instances #-}


---- Some GuiTV examples.  See also the examples in TV.

import Data.List (sort)

import Interface.TV.UI
import Control.Arrow.DeepArrow
import Data.FunArr

-- TypeCompose
import Data.Title

-- To pick up the FunArr instance for OFun.
import Interface.TV.OFun()

-- main = runBoth shopping

-- Run both UI and IO flavors
runBoth :: CTV a -> IO ()
runBoth tv = runUI tv >> runIO tv

-- or runBoth = runUI `mappend` runIO

tv0 :: CTV String
tv0 = tv (title "message" stringOut) "Hello World!"

tv1 :: CTV Int
tv1 = tv (title "answer" showOut) (42 :: Int)

-- This one is too polymorphic for runTV or runUI
reverseT :: ( DefaultOut src snk [a], DefaultIn src [a]
            , CommonOuts snk, CommonIns src
            , Show a, Read a) =>
            TV src snk ([a] -> [a])
reverseT = tv (title "reverse" defaultOut) reverse

-- The following two type specializations are type-constrained enough for runUI

reverseString :: CTV (String -> String)
reverseString = reverseT

reverseInts :: CTV ([Int] -> [Int])
reverseInts = reverseT

--  This one reverses twice
revTwice :: CTV (String -> String)
revTwice = reverseT ->| reverseT

apples, bananas :: CInput Int
apples  = title "apples"  defaultIn
bananas = title "bananas" defaultIn

total :: Show a => COutput a
total = title "total" showOut

shoppingO :: COutput (Int -> Int -> Int)
shoppingO = title "shopping list" $
            oLambda apples (oLambda bananas total)


shopping :: CTV (Int -> Int -> Int)
shopping = tv shoppingO (+)

-- Uncurried variant
shoppingPr :: CTV ((Int,Int) -> Int)
shoppingPr = tv ( title "shopping list -- curried" $ 
                  oLambda (iPair apples bananas) total )
                (uncurry (+))

-- Or simply use uncurryA
shoppingPr' :: CTV ((Int,Int) -> Int)
shoppingPr' = uncurryA $$ shopping


-- Sliders instead of default inputs
applesU, bananasU :: Input UI Int
applesU  = title "apples"  (islider (0,10) 3)
bananasU = title "bananas" (islider (0,10) 7)

shoppingUO :: Output UI IU (Int -> Int -> Int)
shoppingUO = title "shopping list" $
             oLambda applesU (oLambda bananasU total)

shoppingU :: TV UI IU (Int -> Int -> Int)
shoppingU = tv shoppingUO (+)

shoppingPrU :: TV UI IU ((Int,Int) -> Int)
shoppingPrU = uncurryA $$ shoppingU


-- This one is polymorphic in value, so say something like
-- "runBoth (sortT :: CTV ([String] -> [String]))".  If you leave out the type
-- annotation, a will default to Int.
sortT :: (Read a, Show a, Ord a) => CTV ([a] -> [a])
sortT = tv (title "sort" $ interactLineRS []) sort


---- Composition.

-- Idea: unwords, sort, words

instance DefaultOut UI IU [String] where defaultOut = showOut
instance DefaultIn  UI    [String] where defaultIn  = readIn []


wordsT :: CTV (String -> [String]) 
wordsT = tv ( title "function: words" $
              oLambda (title "sentence in" defaultIn)
                      (title "words out"   defaultOut))
            words

unwordsT :: CTV ([String] -> String) 
unwordsT = tv ( title "function: unwords" $
                oLambda (title "words in"     defaultIn)
                        (title "sentence out" defaultOut))
              unwords

sortWordsT :: CTV (String -> String)
sortWordsT = wordsT ->| sortT ->| unwordsT


-- choiceLen :: TV UI IU (String -> Int)
-- choiceLen = tv ( oLambda ( choices (words "a big black bug") "big" ) defaultOut )
--                length

choiceLen :: TV UI IU (String -> Int)
choiceLen = tv ( title "length of choice" $
                 oLambda ( title "choose a word" $
                           choices (words "a big black bug") "big" )
                         (title "length" defaultOut) )
               length