--- /dev/null
+*-sapl
+*-www
+*-data
+*.prj
+Clean System Files
+*.[^l]
+*.o
+test
+gopt
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import qualified Data.Map as DM
+import iTasks
+
+Start w = startEngine t w
+
+t = withShared ["somedata"] \l->
+ forever (chooseAction [((Action "Empty"), ())] >>- \_->set [] l)
+ //-&&- updateSharedInformation [UpdateAs 11
+ -&&- viewSharedInformation "View" [] l
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import iTasks
+import iTasks.Extensions.Document
+
+Start w = startEngine t w
+
+t :: Task Document
+t = enterInformation "bork" []
+ >>= viewInformation "doc" []
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+definition module T
+
+import StdGeneric
+
+:: T
+
+someT :: T
+
+class dyn a | TC a
+derive class dyn T
--- /dev/null
+implementation module T
+
+:: T = T
+
+someT :: T
+someT = T
+
+derive class dyn T
--- /dev/null
+module test
+
+import T
+
+Start = dynamic someT
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import Control.Monad.State
+import Control.Monad.Identity
+import Control.Applicative
+import System.OS
+import qualified Control.Monad as M
+from Control.Monad import `b`, mapM, class Monad(bind)
+import StdArray
+import Data.Tree
+import Data.Functor
+import Data.Tuple
+import Data.Func
+import System.Directory
+import System.File
+import Text.HTML
+import Text
+import iTasks
+import iTasks.Internal.SDS => qualified modify
+import iTasks.Internal.Task
+
+import StdDebug, StdMisc
+
+derive class iTask RTree, FileInfo, Tm
+
+Start w = startEngine (selecter "/home/mrl/projects" 2) w
+
+recurseDirectory :: Int FilePath FilePath *World -> *(MaybeOSError (RTree (FilePath, Bool)), *World)
+recurseDirectory maxdepth acc fp w
+# fp = acc </> fp
+= case getFileInfo fp w of
+ (Error (i, e), w) = (Error (i, e +++ " in fileinfo " +++ fp), w)
+ (Ok fi, w)
+ | not fi.directory = (Ok $ RNode (fp, False) [], w)
+ = case readDirectory fp w of
+ (Error (i, e), w) = (Error (i, e +++ " in readDir " +++ fp), w)
+ (Ok cs, w)
+ | maxdepth == 0 = (Ok $ RNode (fp, True) [], w)
+ = appFst ((fmap $ RNode (fp, True)) o 'M'.sequence)
+ $ mapSt (recurseDirectory (maxdepth - 1) fp) (filter real cs) w
+where
+ real i = IF_POSIX (i <> ".." && i <> ".") True
+
+selecter :: !FilePath Int -> Task String
+selecter fp maxdepth = accWorldOSError (recurseDirectory maxdepth fp "")
+ >>= \ds->editSelection "Examples" False (SelectInTree (\x->[evalState (toTree x) 0]) fromTree) ds []
+ @? tvHd
+where
+ toTree :: (RTree (FilePath, Bool)) -> State Int ChoiceNode
+ toTree (RNode (fp, _) forest)
+ = getState `b` \i->put (i+1) `b` \_->mapM toTree forest `b` \cs->pure
+ {id=i,label=bn fp,icon=Nothing,expanded=i==0,children=cs}
+
+ bn :: FilePath -> FilePath
+ bn x = if (endsWith {pathSeparator} x) (bn $ fst $ splitFileName x) (dropDirectory x)
+
+ fromTree :: (RTree (FilePath, Bool)) [Int] -> [FilePath]
+ fromTree t [i] = map fst $ filter (not o snd) [foldTree (\f fs->[f:flatten fs]) t !! i]
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+definition module fac
+
+fac :: !Int -> Int
--- /dev/null
+implementation module fac
+
+import StdEnv
+
+fac :: !Int -> Int
+fac 0 = 1
+fac n = n * fac (n-1)
--- /dev/null
+#include <stdio.h>
+
+extern int fac(int n);
+
+int cmain()
+{
+ for(int i = 0; i<10; i++)
+ printf("Fac %d: %d\n", i, fac(i));
+}
--- /dev/null
+definition module test
+
+fac :: !Int -> Int
--- /dev/null
+implementation module test
+
+import StdEnv
+
+foreign export fac
+
+fac :: !Int -> Int
+fac 0 = 1
+fac n = n * fac (n-1)
+
+cMain :: !*World -> *(!Int, !*World)
+cMain _ = code {
+ ccall cmain ":I:A"
+ }
+
+Start w = cMain w
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import iTasks
+
+Start w = startEngineWithOptions
+ (\a o->(Just {o & autoLayout=True}, []))
+ (allTasks [t1, t2, t3, t4, t5]) w
+
+t1 = (viewInformation () [] "foo" <<@ InPanel True) @! ()
+
+t2 = (viewInformation () [] "bar" <<@ InPanel True) @! ()
+t3 = return ()
+t4 = return ()
+t5 = return ()
+
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import Data.GenCons
+import Data.Maybe
+import StdArray
+
+:: T =: T Int
+
+derive class gCons T
+derive bimap []
+
+//Start :: (Maybe (Int, Int))
+//Start = consByName "_Tuple2"
+//
+Start = consName{|*|} ss
+
+ss :: {Int}
+ss = {}
--- /dev/null
+definition module C
+
+from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
+from Data.Maybe import :: Maybe
+
+derive class C T
+
+:: T = T
+
+class C a | JSONEncode{|*|}, JSONDecode{|*|} a
--- /dev/null
+implementation module C
+
+import Text.GenJSON
+
+derive JSONEncode T
+derive JSONDecode T
+derive class C T
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import C
+import Text.GenJSON
+
+Start = toJSON T
--- /dev/null
+module gopt
+
+import StdGeneric, StdOverloaded, StdClass, StdArray, StdChar, StdBool, StdList, StdMisc, StdFunc, StdTuple, StdString
+
+import Data.List
+import Data.Error
+import Data.Func
+import Data.Functor
+import Data.Tuple
+import Control.Applicative
+import Control.Monad
+import System.GetOpt
+import System.CommandLine
+// = NoArg a // ^ no argument expected\r
+// | ReqArg (String -> a) String // ^ option requires argument\r
+// | OptArg ((Maybe String) -> a) String // ^ optional argument\r
+//
+:: Opt a
+ = Positionals [ArgDescr (a -> *(MaybeError [String] a))]
+ | Flag (a -> a) (a -> a)
+ | Options [OptDescr (a -> *(MaybeError [String] a))]
+
+//tr fr to (NoArg fa) = NoArg (fm to o fa o fr)
+
+tr fr to (NoArg fa) = NoArg \a->case fa (fr a) of
+ Ok a = Ok (to a)
+ Error e = Error e
+tr fr to (ReqArg fa t) = ReqArg (\s a->case fa s (fr a) of
+ Ok a = Ok (to a)
+ Error e = Error e) t
+tr fr to (OptArg fa t) = OptArg (\ms a->case fa ms (fr a) of
+ Ok a = Ok (to a)
+ Error e = Error e) t
+
+generic gopt a :: Opt a
+gopt{|Bool|} = Flag (const True) (const False)
+gopt{|Int|} = Positionals [ReqArg (\s _->if (and [isDigit c\\c<-:s]) (Ok $ toInt s) (Error ["Not an integer"])) "INT"]
+gopt{|Char|} = Positionals [ReqArg (\s _->if (size s == 1) (Ok s.[0]) (Error ["Not a single character"])) "CHAR"]
+gopt{|String|} = Positionals [ReqArg (\s _->Ok s) "STRING"]
+gopt{|RECORD|} f = case f of
+ Flag set unset = Flag (\(RECORD a)->RECORD (set a)) (\(RECORD a)->RECORD (unset a))
+ Options opts = Options $ map (\(Option s l f h)->(Option s l (tr (\(RECORD a)->a) RECORD f) h)) opts
+ Positionals p = Positionals (map (tr (\(RECORD a)->a) RECORD) p)
+gopt{|FIELD of {gfd_name}|} f = case f of
+ Flag set unset = Options
+ [Option [] [gfd_name] (mapF (NoArg $ Ok o set)) ""
+ ,Option [] ["no-" +++ gfd_name] (mapF (NoArg $ Ok o unset)) ""
+ ]
+ Positionals [p] = Options
+ [Option [] [gfd_name] (mapF p) ""]
+where
+ mapF = tr (\(FIELD a)->a) FIELD
+gopt{|Maybe|} (Positionals [ReqArg f d]) = Positionals
+ [OptArg (\ms _ ->case ms of
+ Nothing = Ok Nothing
+ // Is this necessary
+ Just s = case f s undef of
+ Ok a = Ok (Just a)
+ Error e = Error e
+ ) d]
+gopt{|PAIR|} fx fg = case (fx, fg) of
+ (Options as, Options bs) = Options $
+ [Option s r (topair (\(PAIR l r)->l) (\(PAIR _ r) l->PAIR l r) f) d\\(Option s r f d)<-as]
+ ++ [Option s r (topair (\(PAIR l r)->r) (\(PAIR l _) r->PAIR l r) f) d\\(Option s r f d)<-bs]
+topair fr to (NoArg fa) = NoArg \a->case fa (fr a) of
+ Ok na = Ok (to a na)
+ Error e = Error e
+topair fr to (ReqArg fa d) = ReqArg (\s a->case fa s (fr a) of
+ Ok na = Ok (to a na)
+ Error e = Error e) d
+topair fr to (OptArg fa d) = OptArg (\s a->case fa s (fr a) of
+ Ok na = Ok (to a na)
+ Error e = Error e) d
+
+parseOpts :: (Opt a) [String] a -> MaybeError [String] a
+parseOpts (Options opts) args i
+ # (transformers, positionals, errors) = getOpt Permute [helpopt:opts] args
+ | not (errors =: []) = Error [usageInfo "" [helpopt:opts]:errors]
+ = case folder transformers i of
+ Error e = Error [usageInfo "" [helpopt:opts]:e]
+ Ok a = Ok a
+parseOpts _ _ i = Ok i
+
+helpopt = Option [] ["help"] (NoArg \a->Error []) ""
+
+folder [] i = Ok i
+folder [tr:trs] i = tr i >>= folder trs
+
+:: T =
+ { field :: Maybe Int
+ , field2 :: String
+ }
+derive bimap Opt, [], (,),OptDescr, ArgDescr, MaybeError
+derive gopt T
+
+Start w
+# ([argv0:args], w) = getCommandLine w
+= parseOpts t args { field = Just 42, field2 = ""}
+
+t :: Opt T
+t = gopt{|*|}
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import Data.Tuple
+import iTasks
+import iTasks.Internal.SDS
+import iTasks.Internal.Task
+
+Start w = startEngine t w
+
+t = (watch (sdsFocus True s) >&> \sh->viewSharedInformation "s" [] sh @! "")/* updateSharedInformation "True" [] (sdsFocus True s)*/
+ -||- forever (
+ ((mkInstantTask \tid iw->appFst Ok (listAllSDSRegistrations iw)) @ formatSDSRegistrationsList)
+ >>* [OnAction (Action "Refresh") (withValue (Just o viewInformation "regs" []))])
+ /*
+ -||- viewSharedInformation "True" [] (sdsFocus True s)
+ -||- updateSharedInformation "False" [] (sdsFocus False s)
+ -||- viewSharedInformation "False" [] (sdsFocus False s)*/
+
+s = fnot (sharedStore "someShare" 42)
+
+fnot :: ((SDS () r w) -> (SDS Bool r w)) | TC r & TC w
+fnot = sdsLens "caremuch" (\_->())
+ (SDSRead \p rs ->Ok rs)
+ (SDSWrite \p rs w ->Ok (Just w))
+ (SDSNotify \p1 rs w p2->p1)
+
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import Data.Func
+
+Start = (if` True 42) 52
+
+if` c t e :== if c t e
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import iTasks
+import iTasks.Extensions.Process
+import System.Time
+//import System.Process
+
+Start w = startEngine t w
+
+t = withShared [] \stdin->withShared ([],[]) \stdout->
+ pipe {tv_sec=0,tv_nsec=100000000}
+ "/bin/ls" ["-a", "/home/mrl"] Nothing
+ "/bin/grep" ["steam"] Nothing Nothing
+ stdin stdout
+ -&&- viewSharedInformation () [] stdout
+ -&&- updateSharedInformation () [] stdin
+
+//t = withShared [] \inq->
+// withShared ([], []) \outq->
+// externalProcess {tv_sec=0,tv_nsec=100000000} "/bin/bash" [] Nothing inq outq (Just termios)
+// -|| viewSharedInformation "Output" [] outq
+// -|| forever (enterInformation "Send" [] >>= \nl->upd (\l->l ++ [nl +++ "\n"]) inq)
+// >>* [OnAction (Action "Stop") (always (treturn ()))]
+//termios = {defaultPtyOptions & childInNewSession=True, childControlsTty=True, useRawIO = False}
--- /dev/null
+all:
+ mkdir -p Clean\ System\ Files
+ gcc -c test.c -o test.o
+ clm -l test.o -dynamics -IL Dynamics test -o test
--- /dev/null
+module test
+
+import qualified Data.Map as DM
+import iTasks
+
+Start w = startEngineWithOptions
+ (\as o->(Just {o & autoLayout=True}, []))
+ (parallel
+ [(Embedded, tab "tab1")
+ ,(Embedded, tab "tab2")
+ ]
+ [ OnAction (Action "New") (always (Embedded, \l->appendTask Embedded (tab "New tab") l @! ()))
+ , OnAction (Action " ") (always (Embedded, \l->appendTask Embedded (tab "New tab") l @! ()))
+ , OnAction (Action "Close") (never (Embedded, \l->treturn ()))
+ , OnAction (Action "Dis no icon") (never (Embedded, \l->treturn ()))
+ , OnAction (Action "+") (always (Embedded, \r->treturn ()))
+ ]
+ <<@ ArrangeWithTabs True
+ <<@ ApplyLayout (setActionIcon ('DM'.put " " "new" 'DM'.newMap))
+ ) w
+
+tab title _ = viewInformation title [] () <<@ Title title
+ >>* [OnAction (Action "Close") (always (treturn ()))]
--- /dev/null
+definition module Select
+
+class Selectable a
+where
+ addToSelectSet :: a SelectSet -> SelectSet
+
+instance
repositories / clean-tests.git / commitdiff