Commit def9f1d2 authored by Bas Lijnse's avatar Bas Lijnse

Split up all interactive test into small isolated programs.

parent aa36de4d
module TestButtonBar
import iTasks
test :: Task String
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (wrapUI UIButtonBar)
Start world = startEngine test world
module TestDebug
import iTasks
test :: Task String
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (wrapUI UIDebug)
Start world = startEngine test world
module TestMenu
import iTasks
import qualified Data.Map as DM
test :: Task String
test = enterInformation () [EnterUsing id editor]
//Remove prompt
<<@ ApplyLayout (foldl1 sequenceLayouts [removeSubUIs (SelectByPath [0]),unwrapUI,setUIAttributes (textAttr "Sub menu")])
where
editor = menu2 (button <<@ 'DM'.unions[textAttr "Button a",iconClsAttr "icon-ok"]) (button <<@ (textAttr "Button b"))
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (wrapUI UIMenu)
<<@ ApplyLayout (setUIAttributes (textAttr "Open menu"))
Start world = startEngine test world
module TestPanel
import iTasks
test :: Task String
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (wrapUI UIPanel)
<<@ ApplyLayout (setUIAttributes (titleAttr "Panel with title"))
Start world = startEngine test world
module TestTabSet
import iTasks
test :: Task String
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (setUIAttributes (titleAttr "Tab title"))
<<@ ApplyLayout (wrapUI UITabSet)
Start world = startEngine test world
module TestToolBar
import iTasks
test :: Task String
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (wrapUI UIToolBar)
Start world = startEngine test world
module TestWindow
import iTasks
test :: Task String
test = viewInformation () [] "This is the content of the container"
<<@ ApplyLayout (wrapUI UIWindow)
<<@ ApplyLayout (setUIAttributes (titleAttr "Window with title"))
Start world = startEngine test world
module TestButton
import iTasks, iTasks.Internal.Test.Definition
test :: Task Bool
test = testEditor (button <<@ (textAttr "Click")) False Update
Start world = startEngine test world
module TestCheckGroup
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceText],[Int])
test = testEditor checkGroup ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
Start world = startEngine test world
module TestCheckGroupMulti
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceText],[Int])
test = testEditor (checkGroup <<@ multipleAttr True) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
Start world = startEngine test world
module TestCheckbox
import iTasks, iTasks.Internal.Test.Definition
test :: Task Bool
test = testEditor checkBox False Update
Start world = startEngine test world
module TestChoiceList
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceText],[Int])
test = testEditor (choiceList <<@ multipleAttr False) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
Start world = startEngine test world
module TestChoiceListMulti
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceText],[Int])
test = testEditor (choiceList <<@ multipleAttr True) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
Start world = startEngine test world
module TestDecimalField
import iTasks, iTasks.Internal.Test.Definition
test :: Task Real
test = testEditor decimalField 3.14 Update
Start world = startEngine test world
module TestDocumentField
import iTasks, iTasks.Internal.Test.Definition
test :: Task (!String,!String,!String,!String,!Int)
test = testEditor documentField defaultValue Enter
Start world = startEngine test world
module TestDropdown
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceText],[Int])
test = testEditor (dropdown <<@ multipleAttr False) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
Start world = startEngine test world
module TestGrid
import iTasks, iTasks.Internal.Test.Definition
test :: Task (ChoiceGrid,[Int])
test = testEditor (grid <<@ multipleAttr False) ({ChoiceGrid|header=["Key","Value"],rows=rows},[]) Update
where
rows = [{ChoiceRow|id=1,cells=[Text "A",Text "1"]},{ChoiceRow|id=2,cells=[Text "B",Text "2"]},{ChoiceRow|id=3,cells=[Text "C",Text "3"]}]
Start world = startEngine test world
module TestGridMulti
import iTasks, iTasks.Internal.Test.Definition
test :: Task (ChoiceGrid,[Int])
test = testEditor (grid <<@ multipleAttr True) ({ChoiceGrid|header=["Key","Value"],rows=rows},[]) Update
where
rows = [{ChoiceRow|id=1,cells=[Text "A",Text "1"]},{ChoiceRow|id=2,cells=[Text "B",Text "2"]},{ChoiceRow|id=3,cells=[Text "C",Text "3"]}]
Start world = startEngine test world
module TestGridShare
import iTasks, iTasks.Internal.Test.Definition
test :: Task (ChoiceGrid,[Int])
test = (testEditorWithShare (grid <<@ multipleAttr True) ({ChoiceGrid|header=["Key","Value"],rows=rows},[]) Update)
where
rows = [{ChoiceRow|id=1,cells=[Text "A",Text "1"]},{ChoiceRow|id=2,cells=[Text "B",Text "2"]},{ChoiceRow|id=3,cells=[Text "C",Text "3"]}]
Start world = startEngine test world
module TestHtmlView
import iTasks, iTasks.Internal.Test.Definition
test :: Task HtmlTag
test = testEditor htmlView (H2Tag [] [Text "Hello World"]) Update
Start world = startEngine test world
module TestIcon
import iTasks, iTasks.Internal.Test.Definition
test :: Task (String,Maybe String)
test = testEditor icon ("icon-valid",Just "Icon with a tooltip!") Update
Start world = startEngine test world
module TestIntegerField
import iTasks, iTasks.Internal.Test.Definition
test :: Task Int
test = testEditor integerField 42 Update
Start world = startEngine test world
module TestLabel
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor label "Hello world" Update
Start world = startEngine test world
module TestList
import iTasks, iTasks.Internal.Test.Definition
test :: Task [String]
test = testEditor (listEditor (Just (const (Just "New item"))) True True (Just (\items -> length items +++> " items")) textField) [] Update
Start world = startEngine test world
module TestPasswordField
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor passwordField "Hello world" Update
Start world = startEngine test world
module TestProgressBar
import iTasks, iTasks.Internal.Test.Definition
test :: Task (Maybe Int,Maybe String)
test = testEditor progressBar (Just 90,Just "Almost done") Update
Start world = startEngine test world
module TestSlider
import iTasks, iTasks.Internal.Test.Definition
test :: Task Int
test = testEditor (slider <<@ ('DM'.union (minAttr 1) (maxAttr 5))) 3 Update
Start world = startEngine test world
module TestTextArea
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor textArea "Hello world" Update
Start world = startEngine test world
module TestTextField
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor textField "Hello world" Update
Start world = startEngine test world
module TestTextView
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor textView "Hello World" Update
Start world = startEngine test world
module TestTree
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceNode],[Int])
test = testEditor (tree <<@ multipleAttr False)
([{ChoiceNode|id=1,label="A",icon=Nothing,expanded=False,children=[]}
,{ChoiceNode|id=2,label="B",icon=Nothing,expanded=False,children=[]}
,{ChoiceNode|id=3,label="C",icon=Nothing,expanded=False,children=[]}
],[]) Update
Start world = startEngine test world
module TestTree
import iTasks, iTasks.Internal.Test.Definition
test :: Task ([ChoiceNode],[Int])
test = testEditor (tree <<@ multipleAttr True)
([{ChoiceNode|id=1,label="A",icon=Nothing,expanded=False,children=[]}
,{ChoiceNode|id=2,label="B",icon=Nothing,expanded=False,children=[]}
,{ChoiceNode|id=3,label="C",icon=Nothing,expanded=False,children=[]}
],[]) Update
Start world = startEngine test world
module TestCallProcess
import iTasks
test = viewInformation "Press the button to run an OS process" [] ()
>>| withShared []
\io -> (externalProcess "/bin/date" [] Nothing io {onStartup=onStartup
,onOutData=onOutData
,onErrData=onErrData
,onShareChange=onShareChange
,onExit=onExit} gEditor{|*|}
-|| viewSharedInformation "OUTPUT: " [] io
)
where
onStartup r = (Ok r, Nothing, [], False)
onOutData data l r = (Ok [data:l], Just [data:r], [], False)
onErrData _ l r = (Ok l, Nothing, [], False)
onShareChange l r = (Ok l, Nothing, [], False)
onExit c l r = (Ok l, Nothing)
Start world = startEngine test world
module TestColoredTextField
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor (withAttributes (styleAttr "background-color: pink") textField) "Hello world" Update
Start world = startEngine test world
module TestCombinedTextFields
import iTasks, iTasks.Internal.Test.Definition
test :: Task (String,String)
test = testEditor (container2 textField textField) ("Hello","world") Update
Start world = startEngine test world
module TestDateField
import iTasks, iTasks.Internal.Test.Definition
test :: Task Date
test = testEditor gEditor{|*|} {Date|year=2003,mon=1,day=13} Update
Start world = startEngine test world
module TestLabeledTextField
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor (withLabelAttr "Foo" textField) "Hello world" Update
Start world = startEngine test world
module TestMixedCombinedTextFields
import iTasks, iTasks.Internal.Test.Definition
test :: Task (String,String)
test = testEditor editor ("Hello","world") Update
where
editor = container2 username password
username = pink (withLabelAttr "Username" textField)
password = pink (withLabelAttr "Password" passwordField)
pink e = withAttributes (styleAttr "background-color: pink") e
Start world = startEngine test world
module TestAceEditorWithShare
import iTasks, iTasks.Internal.Test.Definition
test :: Task (AceOptions,AceState)
test = testEditorWithShare aceEditor defaultValue Update
Start world = startEngine test world
module TestAceTextArea
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditor aceTextArea "Hello world" Update
Start world = startEngine test world
module TestAceTextAreaWithShare
import iTasks, iTasks.Internal.Test.Definition
test :: Task String
test = testEditorWithShare aceTextArea "Hello world" Update
Start world = startEngine test world
module TestDashEditlet
import iTasks
import iTasks.Extensions.Dashboard
test = viewInformation "LED" [] LightOnRed
Start world = startEngine test world
module TestEditlet
import iTasks
import iTasks.Extensions.Clock
test = viewSharedInformation "Clock" [ViewAs (\t -> AnalogClock t)] currentTime
Start world = startEngine test world
module TestGoogleMap
import iTasks
import iTasks.Extensions.GIS.GoogleMap
test :: Task GoogleMap
test = enterInformation "Test a Google map" []
Start world = startEngine test world
module TestLeafletMap
import iTasks
import iTasks.Extensions.GIS.Leaflet
test :: Task LeafletMap
test = enterInformation "Test a Leaflet map" []
Start world = startEngine test world
module TestPikadayEditlet
import iTasks.Extensions.Form.Pikaday
test :: Task Date
test = testEditorWithShare pikadayDateField defaultValue Update
Start world = startEngine test world
module TestSVGEditlet
import iTasks
import StdReal
from Graphics.Scalable import px, above, class toSVGColor(..), instance toSVGColor String, instance toSVGColor RGB
from Graphics.Scalable import :: Host(..), :: SVGColor(..), :: RGB(..), :: FillAttr(..), :: StrokeAttr(..), :: OnClickAttr(..)
from Graphics.Scalable import <@<, class tuneImage(..), rect, text, overlay, normalFontDef
from Graphics.Scalable import instance tuneImage FillAttr, instance tuneImage StrokeAttr, instance tuneImage OnClickAttr
import iTasks.Extensions.SVG.SVGEditor
testSVGEditlet = itest "SVG editlet rendering" "Look at the image presented" "You should see the dutch flag" tut
where
tut = updateInformation "SVG image" [UpdateUsing id (const id) (fromSVGEditor svgeditor)] 42
svgeditor = {SVGEditor|initView=const (),renderImage = \_ _ _ -> nederland, updView = \m v -> v, updModel = \m v -> m}
nederland :: Image m
nederland = banden (H *. 3 /. 2,H) [toSVGColor {r=174,g=28,b=40},toSVGColor "white",toSVGColor {r=33,g=70,b=139}]
banden (w,h) kleuren = above [] [] [rect w (h /. (length kleuren)) <@< {fill = kleur} <@< {stroke = toSVGColor "none"} \\ kleur <- kleuren] NoHost
H = px 32.0
W = H *. 1.5
Start world = startEngine test world
module TestSVGEditClick
import iTasks
import StdReal
from Graphics.Scalable import px, above, class toSVGColor(..), instance toSVGColor String, instance toSVGColor RGB
from Graphics.Scalable import :: Host(..), :: SVGColor(..), :: RGB(..), :: FillAttr(..), :: StrokeAttr(..), :: OnClickAttr(..)
from Graphics.Scalable import <@<, class tuneImage(..), rect, text, overlay, normalFontDef
from Graphics.Scalable import instance tuneImage FillAttr, instance tuneImage StrokeAttr, instance tuneImage OnClickAttr
import Graphics.Scalable.Internal
testSVGEditletClick = itest "SVG editlet clicks" "Click on the image a couple of times" "The text should update to reflect the number of clicks" tut
where
tut = updateInformation "SVG Clicks" [UpdateUsing (\m -> m) (\m v -> v) (fromSVGEditor svgeditor)] "No clicks"
>&> \s -> viewSharedInformation "DEBUG" [] s
svgeditor = {SVGEditor|initView=id,renderImage = renderImage, updView = \m v -> m, updModel = \m v -> v}
renderImage :: String String *TagSource -> Image String
renderImage str _ _
#! r = rect (px 100.0) (px 100.0)
#! t = text (normalFontDef "Arial" 10.0) str <@< { fill = toSVGColor "white" }
= overlay (repeat (AtMiddleX, AtMiddleY)) [] [t] (Host r) <@< { onclick = \n _ -> case n of
1 -> "one click"
2 -> "double click"
n -> toString n +++ " clicks"
, local = False }
Start world = startEngine test world
module TestADTMultiCons
import iTasks, iTasks.Internal.Test.Definition
:: ADTMultiCons
= ADTMultiConsNone
| ADTMultiConsSingle Int
| ADTMultiConsMulti Int String
derive class iTask ADTMultiCons
test :: Task ADTMultiCons
test = testCommonInteractions "ADTMultiCons"
Start world = startEngine test world
module TestADSingleConsMany
import iTasks, iTasks.Internal.Test.Definition
:: ADTSingleConsMany = ADTSingleConsMany String Int String Int String
derive class iTask ADTSingleConsMany
test :: Task ADTSingleConsMany
test = testCommonInteractions "ADTSingleConsMany"
Start world = startEngine test world
module TestADTSingleConsMulti
import iTasks, iTasks.Internal.Test.Definition
:: ADTSingleConsMulti = ADTSingleConsMulti Int String
derive class iTask ADTSingleConsMulti
test :: Task ADTSingleConsMulti
test = testCommonInteractions "ADTSingleConsMulti"
Start world = startEngine test world
module TestADTSingleConsOne
import iTasks, iTasks.Internal.Test.Definition
:: ADTSingleCons = ADTSingleCons Int
derive class iTask ADTSingleCons
test :: Task ADTSingleCons
test = testCommonInteractions "ADTSingleCons"
Start world = startEngine test world
module TestBool
import iTasks, iTasks.Internal.Test.Definition
test :: Task Bool
test = testCommonInteractions "Bool"
Start world = startEngine test world
definition module Tests.Interactive.Editlets
module TestChar
import iTasks, iTasks.Internal.Test.Definition
testEditletsI :: TestSuite
test :: Task Char
test = testCommonInteractions "Char"
Start world = startEngine test world
module TestCustomList
import iTasks, iTasks.Internal.Test.Definition
:: List = Nil | Cons Int List
derive class iTask List
test :: Task List
test = testCommonInteractions "Custom list"
Start world = startEngine test world
module TestInt
import iTasks, iTasks.Internal.Test.Definition
test :: Task Int
test = testCommonInteractions "Int"
Start world = startEngine test world
module TestIntList
import iTasks, iTasks.Internal.Test.Definition
test :: Task [Int]
test = testCommonInteractions "Int list"
Start world = startEngine test world
module TestNestedRecord
import iTasks, iTasks.Internal.Test.Definition
:: TwoFieldRecord =
{ first :: Int
, second :: String
}
:: NestedRecord =
{ firstTwo :: TwoFieldRecord
, third :: Bool
}
derive class iTask TwoFieldRecord, NestedRecord
test :: Task NestedRecord
test = testCommonInteractions "NestedRecord"
Start world = startEngine test world
module TestOptionalRecord
import iTasks, iTasks.Internal.Test.Definition
:: TwoFieldRecord =
{ first :: Int
, second :: String
}
derive class iTask TwoFieldRecord
test :: Task (Maybe TwoFieldRecord)
test = testCommonInteractions "Optional record"
Start world = startEngine test world
module TestReal
import iTasks, iTasks.Internal.Test.Definition
test :: Task Real
test = testCommonInteractions "Real"
Start world = startEngine test world
module TestRecordWithADT
import iTasks, iTasks.Internal.Test.Definition
:: ADTMultiCons
= ADTMultiConsNone
| ADTMultiConsSingle Int
| ADTMultiConsMulti Int String
:: RecordWithADT =
{ first :: String
, second :: ADTMultiCons
}
derive class iTask ADTMultiCons, RecordWithADT
test :: Task RecordWithADT
test = testCommonInteractions "Record with ADT"
Start world = startEngine test world
module TestSingleRecord
import iTasks, iTasks.Internal.Test.Definition
:: TwoFieldRecord =
{ first :: Int