From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 14 Feb 2019 10:54:43 +0000 (+0100)
Subject: godpt
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=03d5a3c82e7b112f2b3a7fe86354f43add6af59e;p=clean-tests.git

godpt
---

diff --git a/gopt/gopt.icl b/gopt/gopt.icl
index 57cf229..09089ab 100644
--- a/gopt/gopt.icl
+++ b/gopt/gopt.icl
@@ -36,12 +36,13 @@ combine` sel app p s t = p s (sel t) >>= \(l, as)->pure ((app (const l) t), as)
 ar0 s f as = Ok o flip tuple as o f
 
 generic gopt a *! :: Opt a
+//generic gopt a :: Opt a
 gopt{|Bool|} = BinaryFlag (const True) (const False)
 gopt{|Int|} = Positionals [("INT", \s _->if (and [isDigit c\\c<-:s]) (Ok $ toInt s) (Error ["Not an integer"]))]
 gopt{|Char|} = Positionals [("CHAR", \s _->if (size s == 1) (Ok s.[0]) (Error ["Not a single character"]))]
 gopt{|String|} = Positionals [("STRING", \s _->Ok s)]
-gopt{|RECORD|} f = bifmap (\(RECORD a)->a) RECORD f
-gopt{|OBJECT|} f = bifmap (\(OBJECT a)->a) OBJECT f
+gopt{|RECORD|} f = bifmap (\(RECORD a)->a) (\x->RECORD x) f
+gopt{|OBJECT|} f = bifmap (\(OBJECT a)->a) (\x->OBJECT x) f
 gopt{|FIELD of {gfd_name}|} f = case f of
 	//Child is a boolean
 	BinaryFlag set unset = mapF $ Flags [(gfd_name, ar0 gfd_name set), ("no-" +++ gfd_name, ar0 ("no-" +++ gfd_name) unset)]
@@ -54,7 +55,7 @@ gopt{|FIELD of {gfd_name}|} f = case f of
 	x = abort "Subparsers not supported"
 where
 	mapF :: ((m a) -> m (FIELD a)) | bifmap m
-	mapF = bifmap (\(FIELD a)->a) FIELD
+	mapF = bifmap (\(FIELD a)->a) (\x->FIELD x)
 
 	ptoarg [p] [] i = Error ["Not enough arguments for " +++ gfd_name]
 	ptoarg [(_, p):ps] [a:as] i = p a i >>= ptoarg ps as
diff --git a/parserParser/testclass.icl b/parserParser/testclass.icl
new file mode 100644
index 0000000..904bf40
--- /dev/null
+++ b/parserParser/testclass.icl
@@ -0,0 +1,105 @@
+module testclass
+
+import StdEnv
+
+import Data.Maybe
+import Data.Either
+import Data.Functor
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State
+
+import Text.Parsers.Simple.Chars
+import Text.Parsers.Simple.Core
+
+class parsable a ~b :: a -> Parser Char b
+
+instance parsable IntParse Int where
+	parsable IntParse = foldl (\a d->a*10 + digitToInt d) 0 <$> some pDigit
+
+instance parsable (AltParse a) b | parsable a b where
+	parsable (l |. r) = parsable l <|> parsable r
+
+:: IntParse = IntParse
+:: AltParse a = (|.) infixl 1 a a
+
+Start = 42
+
+
+//:: In a b = (:.) infix 0 a b
+//
+//:: Gram
+//	= Lit String
+//	| Int
+//	| (-.) infixr 2 Gram Gram
+//	| (|.) infixl 1 Gram Gram
+//	| *! Gram
+//	| ?! Gram
+//Lits = foldr1 (|.) o map Lit
+//foldr1 f [x:xs] = foldr f x xs
+//:: Gast
+//	= INT Int
+//	| LIT String
+//	| BIN Gast Gast
+//	| OPT (Maybe Gast)
+//	| MANY [Gast]
+//
+//parseFromGram :: Gram -> Parser String Gast
+//parseFromGram  Int     = INT o toInt <$> pSatisfy (\s->toString (toInt s) == s)
+//parseFromGram (Lit i)  = LIT <$> pSatisfy ((==)i)
+//parseFromGram (?! g)   = OPT <$> optional (parseFromGram g)
+//parseFromGram (*! g)   = MANY <$> many (parseFromGram g)
+//parseFromGram (a -. b) = BIN <$> parseFromGram a <*> parseFromGram b
+//parseFromGram (a |. b) = parseFromGram a <|> parseFromGram b
+//
+////Start = runParser (parseFromGram gram) [".","."]
+//Start = printeval <$> parse (parseFromGram gram) ["4","*","2","*","1","*","(","3","^","3","^","3",")"]
+//where
+//	gram =
+//		let lit  =  Lit "(" -. expr -. Lit ")"
+//		         |. Int
+//		    pow  =  lit -. ?! (Lit "^" -. pow)
+//		    fac  =  pow -. *! (Lits ["*","/"] -. pow)
+//		    expr =  fac -. *! (Lits ["+","-","%"] -. fac)
+//		in  expr
+//
+//	printeval a = (eval a, print a)
+//	
+//	eval :: Gast -> Maybe Int
+//	eval (BIN (LIT "(") (BIN e (LIT ")"))) = eval e
+//	eval (INT i) = Just i
+//	eval (LIT _) = Nothing
+//	eval (BIN l (OPT Nothing)) = eval l
+//	eval (BIN l (OPT (Just a))) = eval (BIN l a)
+//	//Right associative operators
+//	eval (BIN l (BIN (LIT op) r)) = op2op op <*> eval l <*> eval r
+//	//Left associative operators
+//	eval (BIN l (MANY [])) = eval l
+//	eval (BIN l (MANY [BIN (LIT op) r:rest]))
+//		= eval (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
+//	eval e = abort ("eval: " +++ printToString e +++ "\n")
+//
+//	print :: Gast -> String
+//	print (BIN (LIT "(") (BIN e (LIT ")"))) = "(" +++ print e +++ ")"
+//	print (INT i) = toString i
+//	print (LIT l) = l
+//	print (BIN l (OPT Nothing)) = print l
+//	print (BIN l (OPT (Just a))) = print (BIN l a)
+//	//Right associative operators
+//	print (BIN l (BIN (LIT op) r)) = "(" +++ print l +++ op +++ print r +++ ")"
+//	//Left associative operators
+//	print (BIN l (MANY [])) = print l
+//	print (BIN l (MANY [BIN (LIT op) r:rest]))
+//		= print (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
+//	print e = printToString e +++ "\n"
+//
+//	op2op "+" = Just (+)
+//	op2op "-" = Just (-)
+//	op2op "*" = Just (*)
+//	op2op "/" = Just (/)
+//	op2op "%" = Just (rem)
+//	op2op "^" = Just (^)
+//	op2op _ = Nothing
+//
+//import Text.GenPrint
+//derive gPrint Gast, Maybe
diff --git a/tcp/test.icl b/tcp/test.icl
index e5f494e..edfea7a 100644
--- a/tcp/test.icl
+++ b/tcp/test.icl
@@ -4,7 +4,7 @@ import iTasks
 import StdMisc,StdDebug
 import Data.Maybe
 
-Start w = startEngine t w
+Start w = doTasks (onStartup t) w
 
 t = withShared () \channels->
 	tcpconnect "localhost" 8123 channels
@@ -14,12 +14,12 @@ t = withShared () \channels->
 			onShareChange=onShareChange,
 			onDisconnect=onDisconnect}
 	where
-		onConnect acc ()
-			| not (trace_tn "onConnect") = undef
+		onConnect cid acc ()
+			| not (trace_tn ("onConnect: " +++ toString cid)) = undef
 			= (Ok "", Nothing, [], False)
 
 		onData newdata acc ()
-			| not (trace_tn "onData") = undef
+			| not (trace_tn ("onData: " +++ newdata)) = undef
 			= (Ok "", Nothing, [], False)
 		
 		onShareChange acc ()