X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=test.icl;h=822f41d96f79c20b12a4020c848454a937724434;hb=0140429ff1785b6ff033813fe4d4c7cdb018e5a9;hp=88f470bd29d77f9dfd6e74bb14e6678177e805c8;hpb=e1f8e1ebd0c95e7bfefb6618a5996fe9b3accc04;p=clean-tests.git diff --git a/test.icl b/test.icl index 88f470b..822f41d 100644 --- a/test.icl +++ b/test.icl @@ -1,48 +1,38 @@ module test -import Data.Func -import qualified Data.Map as DM -import iTasks - -/* -Start w = doTasksWithOptions -// (\a o->Ok o) - (\a o->Ok {o & autoLayout=False}) - (parallel - [(Embedded, tab "tab1") - ,(Embedded, tab "tab2") - ] - [ OnAction (Action "New") (always (Embedded, tab "New tab")) - , OnAction (Action " ") (always (Embedded, tab "New tab")) - , OnAction (Action "Close") (never (Embedded, \_->treturn ())) - , OnAction (Action "Dis no icon") (never (Embedded, \_->treturn ())) - , OnAction (Action "+") (always (Embedded, \_->treturn ())) - ] -// <<@ ArrangeWithTabs True - <<@ ApplyLayout (setActionIcon ('DM'.put " " "new" 'DM'.newMap)) - ) w - -tab title _ = tune (Title title) - $ viewInformation [] title - >>* [OnAction (Action "Close") (always (treturn ()))] -*/ - -import StdDebug, Text.GenPrint -Start w = doTasks (onStartup t) w - -null :: SDSSource () () () -null = nullShare - -t = tcpconnect "localhost" 9999 (Just 500) null -//t = tcpconnect "localhost" 9999 Nothing null - { onConnect = \cid host r = trace_n (printToString ("onConnect: ", cid, host, r)) - (Ok (), Nothing, [], False) - , onData = \ data l r = trace_n (printToString ("onData: ", data, l, r)) - (Ok (), Nothing, [], False) - , onShareChange = \ l r = trace_n (printToString ("onShareChange: ", l, r)) - (Ok (), Nothing, [], False) - , onDisconnect = \ l r = trace_n (printToString ("onDisconnect: ", l, r)) - (Ok (), Nothing) - , onDestroy = \ l = trace_n (printToString ("onDestroy: ", l)) - (Ok (), []) - } +import StdEnv +import Data.Maybe +import Data.Functor +import Control.Monad +import Control.Applicative + +class expr v where + lit :: i -> v i | toString i + (+.) infixl 6 :: (v i) (v i) -> v i | + i + +instance + (v a) | expr v & + a where + + l r = l +. r + +eval :: (Maybe a) -> Maybe a +eval x = x +instance expr Maybe where + lit i = Just i + +. x y = (+) <$> x <*> y + +:: Print a =: Print String +print :: (Print a) -> String +print (Print a) = a +instance expr Print where + lit i = Print (toString i) + +. (Print l) (Print r) = Print (l +++ "+" +++ r) + +printEval :: (A.v: v a | expr v) -> (Maybe a, String) +//printEval f = (f, let (Print p) = f in p) +printEval f = (eval f, print f) + +//Mag niet +//Start :: (Maybe Int, String) +//Start = printEval (lit 4 + lit 38) + +//Mag wel +Start = let (Print f) = lit 4 + lit 38 in f