From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 21 Sep 2018 07:02:55 +0000 (+0200)
Subject: fp
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=1eb7ba9a34eacb68c762bd9f7f81865cf37ecb0b;p=clean-tests.git

fp
---

diff --git a/filepicker/test.icl b/filepicker/test.icl
index fa05452..f308b33 100644
--- a/filepicker/test.icl
+++ b/filepicker/test.icl
@@ -30,7 +30,8 @@ where
 selectFile :: FilePath -> Task FilePath
 selectFile root = get (sdsFocus root directoryShare)
 	>>= \cs->withShared (RNode root (map fst cs)) \tree->
-	editSelectionWithShared () False selectOption tree :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (c -> [Int]) -> Task [a] 
+	editSelectionWithShared () False selectOption (mapRead numberTree tree)
+		(\tree->[i\\(i, (f, _))<-leafs tree])
 
 selectFile :: !FilePath !d !Bool [FilePath]-> Task [FilePath] | toPrompt d
 selectFile root prompt multi initial
diff --git a/inf-default/test.icl b/inf-default/test.icl
new file mode 100644
index 0000000..3cd5465
--- /dev/null
+++ b/inf-default/test.icl
@@ -0,0 +1,24 @@
+module test
+
+import StdList, StdEnum
+import StdGeneric
+
+generic gFDomain a :: [a]
+gFDomain{|Bool|}         = [False,True]
+gFDomain{|Char|}         = map toChar [0..255]
+gFDomain{|UNIT|}         = [UNIT]
+gFDomain{|PAIR|}   dx dy = [PAIR x y \\ x <- dx, y <- dy]
+gFDomain{|EITHER|} dx dy = map LEFT dx ++ map RIGHT dy
+gFDomain{|CONS|}   dx    = [CONS x\\x<-dx]
+gFDomain{|FIELD|}  dx    = [FIELD x\\x<-dx]
+gFDomain{|OBJECT|} dx    = [OBJECT x\\x<-dx]
+
+derive bimap []
+derive gFDomain T
+
+:: T = S T | Z
+
+Start = hd [() \\ _ <- dom]
+
+dom :: [T]
+dom = gFDomain{|*|}
diff --git a/iot/test.icl b/iot/test.icl
new file mode 100644
index 0000000..be9018d
--- /dev/null
+++ b/iot/test.icl
@@ -0,0 +1,69 @@
+module test
+
+import StdEnv
+
+import Data.Func
+import Data.Either
+import Data.Functor
+import Data.Functor.Identity
+import Data.Tuple
+import Data.Error
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Identity
+
+import System.File
+
+:: ErrorT e m a = ErrorT (m (Either e a))
+
+runErrorT (ErrorT m) = m
+
+instance Functor (ErrorT e m) | Functor m
+where
+	fmap f a = ErrorT $ fmap (fmap f) $ runErrorT a
+
+instance Applicative (ErrorT e m) | Functor m & Monad m
+where
+	pure a = ErrorT $ pure $ Right a
+	(<*>) f v = ErrorT $ runErrorT f
+		>>= \mf->case mf of
+			Left e = pure $ Left e
+			Right k = runErrorT v
+				>>= \mv->case mv of
+					Left e = pure (Left e)
+					Right x = pure $ Right $ k x
+
+instance Monad (ErrorT e m) | Monad m
+where
+	bind m k = ErrorT $ runErrorT m
+		>>= \a->case a of
+			Left l = pure $ Left l
+			Right r = runErrorT (k r)
+
+:: IOT m a = IOT (*World -> *(m a, *World))
+
+runIOT (IOT f) = f
+
+instance Functor (IOT m) | Functor m
+where
+	fmap f a = IOT \w->appFst (fmap f) $ runIOT a w
+//instance Applicative (IOT m) | Applicative m
+//where
+//	pure a = IOT $ tuple $ pure a
+//	(<*>) f v = IOT \w->
+//		case runIOT f w of
+//			(Left e, w) = (Left e, w)
+//			(Right ff, w) = case runIOT v w of
+//				(Left e, w) = (Left e, w)
+//				(Right fv, w) = (Right (ff fv), w)
+
+
+//liftIOT :: (*World -> *(MaybeError e a, *World)) -> ErrorT e (StateT *World Identity) String
+//liftIOT f = ErrorT $ StateT \w->case f w of
+//	(Ok a, w`) = pure (pure a, w`)
+
+liftIO :: (*World -> *(a, *World)) -> State *World a
+liftIO f = state f
+
+Start = 42//liftIOT (readFile "/opt/clean/etc/IDEEnvs")
diff --git a/library/test.icl b/library/test.icl
new file mode 100644
index 0000000..1081015
--- /dev/null
+++ b/library/test.icl
@@ -0,0 +1,3 @@
+module test
+
+Start = 42
diff --git a/sequence_slow/test.icl b/sequence_slow/test.icl
index 58ea034..48de0f0 100644
--- a/sequence_slow/test.icl
+++ b/sequence_slow/test.icl
@@ -5,7 +5,7 @@ import iTasks
 import iTasks.Extensions.DateTime
 
 Start w = startEngine (
-	sequence (map t [0..3]) >>- traceValue) w
+	sequence (map t [0..20]) >>- traceValue) w
 
 t i = waitForTimer 1 -|| viewInformation () [] (toString i +++ "th item")
 	>>- \_->treturn i
diff --git a/tcp/test.icl b/tcp/test.icl
index 29a4b71..e5f494e 100644
--- a/tcp/test.icl
+++ b/tcp/test.icl
@@ -7,8 +7,7 @@ import Data.Maybe
 Start w = startEngine t w
 
 t = withShared () \channels->
-	forever (chooseAction [(Action "Set", ())] >>- \_->set () channels)
-	||- tcpconnect "localhost" 8123 channels
+	tcpconnect "localhost" 8123 channels
 		{ConnectionHandlers|
 			onConnect=onConnect,
 			onData=onData,