fp
authorMart Lubbers <mart@martlubbers.net>
Fri, 21 Sep 2018 07:02:55 +0000 (09:02 +0200)
committerMart Lubbers <mart@martlubbers.net>
Fri, 21 Sep 2018 07:02:55 +0000 (09:02 +0200)
filepicker/test.icl
inf-default/test.icl [new file with mode: 0644]
iot/test.icl [new file with mode: 0644]
library/test.icl [new file with mode: 0644]
sequence_slow/test.icl
tcp/test.icl

index fa05452..f308b33 100644 (file)
@@ -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 (file)
index 0000000..3cd5465
--- /dev/null
@@ -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 (file)
index 0000000..be9018d
--- /dev/null
@@ -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 (file)
index 0000000..1081015
--- /dev/null
@@ -0,0 +1,3 @@
+module test
+
+Start = 42
index 58ea034..48de0f0 100644 (file)
@@ -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
index 29a4b71..e5f494e 100644 (file)
@@ -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,