--- /dev/null
+module expr
+
+import StdEnv
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+import Data.Func
+import Data.Functor
+import Text.Parsers.Simple.Core
+import Text.Parsers.Simple.Chars
+
+class expr e where
+ lit :: a -> e a | toString a
+ (+.) infixl 6 :: (e a) (e a) -> e a | + a
+class div e where
+ (/.) infixl 7 :: (e a) (e a) -> e a | /, ==, zero a
+class eq e where
+ (==.) infix 4 :: (e a) (e a) -> e Bool | == a
+
+:: Print a = P String
+runPrint :: (Print a) -> String
+runPrint (P a) = a
+instance expr Print where
+ lit a = P (toString a)
+ (+.) (P a) (P b) = P (a +++ "+" +++ b)
+instance div Print where
+ (/.) (P a) (P b) = P (a +++ "/" +++ b)
+instance eq Print where
+ (==.) (P a) (P b) = P (a +++ "==" +++ b)
+
+:: Eval a = E a
+runEval :: (Eval a) -> a
+runEval (E a) = a
+instance expr Eval where
+ lit a = E a
+ (+.) (E a) (E b) = E (a + b)
+instance div Eval where
+ (/.) (E a) (E b)
+ | b == zero = E zero
+ = E (a / b)
+instance eq Eval where
+ (==.) (E a) (E b) = E (a == b)
+
+:: EvalM a :== MaybeError String a
+runEvalM :: (EvalM a) -> MaybeError String a
+runEvalM a = a
+instance expr (MaybeError String) where
+ lit a = pure a
+ (+.) l r = (+) <$> l <*> r
+instance div (MaybeError String) where
+ (/.) l r = (/) <$> l <*> (r >>= \v->if (v == zero) (Error "div0") (pure v))
+instance eq (MaybeError String) where
+ (==.) l r = (==) <$> l <*> r
+
+pToken c = pSatisfy ((==)c)
+class parseExpr v a | expr, div v
+where
+ parseExpr :: Parser Char (v a)
+instance parseExpr v Int | expr, div v where
+ parseExpr = parseE
+instance parseExpr v Real | expr, div v where
+ parseExpr = parseE
+//instance parseExpr (v Real) where
+// parseExpr
+
+parseE :: Parser Char (v a) | expr, div v & parsable, ==, +, /, zero, toString a
+parseE = foldr ($) parseBasic
+ [ flip pChainl1 (pToken '+' $> (+.))
+ , flip pChainl1 (pToken '/' $> (/.))
+ ]
+where
+ parseBasic = lit <$> parsable
+
+class parsable a :: Parser Char a
+instance parsable Int where parsable = foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
+instance parsable Real where parsable = foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
+
+Start :: Either [Error] (Print Int)
+Start = parse parseExpr ['42+42']
+/*Start = (runPrint e, runEval e, runEvalM e, parse )
+where
+ e :: v Bool | expr, div, eq v
+ e = lit 39 +. lit 3 /. lit 0 ==. lit 4
+*/
import iTasks
-Start w = doTasks t w
-
-t:==palindrome
+import iTasks.Extensions.DateTime
+import iTasks.UI.Layout.Minimal
-palindrome :: Task (Maybe String)
-palindrome
- = enterInformation "Enter a palindrome" []
- >>* [ OnAction ActionOk (ifValue palindrome (\v -> return (Just v)))
- , OnAction ActionCancel (always (return Nothing))
- ]
- >>= viewInformation "Result is:" []
+Start w = doTasksWithOptions opt p2 w
where
- palindrome s = lc == reverse lc
- where
- lc :: [Char]
- lc = fromString s
+ t :: Task DateTime
+ t = waitForTimer 7
+ t2 :: Task Int
+ t2 = enterInformation () [] >>= viewInformation () []
+ t3 :: Task String
+ t3 = withShared 3 \sh->
+ withTemporaryDirectory (viewInformation () [])
+ >>= viewInformation () []
+ t4 = updateInformation () [] 42
+
+ t5 = sequence [return i\\i<-[0..1000]] >>= viewInformation () []
+ t6 = waitForTimer 10
+
+ t7 :: Int -> Task Int
+ t7 i = viewInformation () [] i >>= \x->t7 (x + 1)
-//t :: Task (Int, Int)
-//t = enterInformation "Left" [] -&&- enterInformation "Right" []
-// >>= viewInformation "Result" []
+ p = parallel [(Embedded, \_->waitForTimer 5)] []
+ p1 = waitForTimer 5 -||- waitForTimer 10
+ p2 = withShared 3 \sh->watch sh
-//import Data.GenDefault
+ opt args eo = Ok eo
+// opt args eo = Ok {eo & autoLayout=False}
+
+/*
+//import StdEnv
+//import Data.Error
+//import Data.Maybe
+//import Network.IP
+//import System.Socket
+//import System.Socket.Ipv4
+////import System.Select
//
-//:: T =
-// { a0 :: Int
-// , a1 :: Int
-// , a2 :: Int
-// , a3 :: Int
-// , a4 :: Int
-// , a5 :: Int
-// , a6 :: Int
-// , a7 :: Int
-// , a8 :: Int
-// , a9 :: Int
-// , a10 :: Int
-// , a11 :: Int
-// , a12 :: Int
-// , a14 :: Int
-// , a15 :: Int
-// , a16 :: Int
-// , a17 :: Int
-// , a18 :: Int
-// , a19 :: Int
-// , a20 :: Int
-// , a21 :: Int
-// , a22 :: Int
-// , a23 :: Int
-// , a24 :: Int
-// , a25 :: Int
-// , a26 :: Int
-// , a27 :: Int
-// , a28 :: Int
-// , a29 :: Int
-// , a30 :: Int
-// , a31 :: Int
-// , a32 :: Int
-// }
+from Data.Map import singleton
+import Data.Map.GenJSON
+//import Data.Func
+import iTasks
+
+import iTasks.Extensions.Files
+
+//Start w = doTasks (onStartup (copyFile "/home/mrl/test.txt" "/home/mrl/test2.txt")) w
+//Start w = doTasks (onStartup (workAs SystemUser (return 42))) w
+Start w = doTasks t w
+
+t = viewInformation () [] ()
+ >>* [OnAction ActionOk (always (return ()))
+ ,OnAction ActionQuit (always (return ()))
+ ]
+
+//Start w = doTasks t w
//
-//class c a
-//where
-// a0 :: a
-// a1 :: a
-// a2 :: a
-// a3 :: a
-// a4 :: a
-// a5 :: a
-// a6 :: a
-// a7 :: a
-// a8 :: a
-// a9 :: a
-// a10 :: a
-// a11 :: a
-// a12 :: a
-// a14 :: a
-// a15 :: a
-// a16 :: a
-// a17 :: a
-// a18 :: a
-// a19 :: a
-// a20 :: a
-// a21 :: a
-// a22 :: a
-// a23 :: a
-// a24 :: a
-// a25 :: a
-// a26 :: a
-// a27 :: a
-// a28 :: a
-// a29 :: a
-// a30 :: a
-// a31 :: a
-// a32 :: a
-// a33 :: a
-//
+//t :: Task [(Int, TaskValue Int)]
+//t = parallel
+// [(Embedded, \stl->
+// appendTask Embedded (\_->viewInformation "Int" [] 42) stl
+// >>! \i->set (singleton "focus" "true") (sdsFocus i (taskListEntryMeta stl))
+// >>~ \_->viewSharedInformation "Parallel task list" []
+// (sdsFocus {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeProgress=True,includeAttributes=True} stl)
+// @! 42
+// )] []
+
+
+//import StdGeneric
//
-//derive gDefault T
+//generic g a :: a
//
-//Start :: T
-//Start = gDefault{|*|}
+//g{|*|} = 42
+
+//Start :: *World -> (MaybeOSError String, *World)
+//Start w
+// = case socket SocketStream w of
+// (Error e, w) = (Error e, w)
+// (Ok sockfd, w)
+// #! (merr, sockfd) = connect {ipv4_socket_port=8124,ipv4_socket_addr=Just (fromString "127.0.0.1")} sockfd
+// | isError merr = (liftError merr, w)
+// #! (merr, sockfd) = recv 128 [] sockfd
+// | isError merr = (merr, w)
+// # (Ok msg) = merr
+// # (merr, w) = close sockfd w
+// | isError merr = (liftError merr, w)
+// = (Ok msg, w)
+*/