From af595886d03bdf67057026993cebda553661eff5 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 25 May 2018 20:44:48 +0200 Subject: [PATCH] Initial commit --- .gitignore | 9 +++ append-ed/Makefile | 4 ++ append-ed/test.icl | 11 ++++ documents/Makefile | 4 ++ documents/test.icl | 10 ++++ dyn/Makefile | 4 ++ dyn/T.dcl | 10 ++++ dyn/T.icl | 8 +++ dyn/test.icl | 5 ++ filepicker/Makefile | 4 ++ filepicker/test.icl | 58 +++++++++++++++++++ foreign/Makefile | 4 ++ foreign/fac.dcl | 3 + foreign/fac.icl | 7 +++ foreign/test.c | 9 +++ foreign/test.dcl | 3 + foreign/test.icl | 16 ++++++ fullscreen/Makefile | 4 ++ fullscreen/test.icl | 15 +++++ gencons/Makefile | 4 ++ gencons/test.icl | 18 ++++++ generic_classes/C.dcl | 10 ++++ generic_classes/C.icl | 7 +++ generic_classes/Makefile | 4 ++ generic_classes/test.icl | 6 ++ gopt/gopt.icl | 101 ++++++++++++++++++++++++++++++++++ iTasks-notifications/Makefile | 4 ++ iTasks-notifications/test.icl | 26 +++++++++ if/Makefile | 4 ++ if/test.icl | 7 +++ new-external/Makefile | 4 ++ new-external/test.icl | 24 ++++++++ parallel-action/Makefile | 4 ++ parallel-action/test.icl | 23 ++++++++ select/Select.dcl | 7 +++ 35 files changed, 441 insertions(+) create mode 100644 .gitignore create mode 100644 append-ed/Makefile create mode 100644 append-ed/test.icl create mode 100644 documents/Makefile create mode 100644 documents/test.icl create mode 100644 dyn/Makefile create mode 100644 dyn/T.dcl create mode 100644 dyn/T.icl create mode 100644 dyn/test.icl create mode 100644 filepicker/Makefile create mode 100644 filepicker/test.icl create mode 100644 foreign/Makefile create mode 100644 foreign/fac.dcl create mode 100644 foreign/fac.icl create mode 100644 foreign/test.c create mode 100644 foreign/test.dcl create mode 100644 foreign/test.icl create mode 100644 fullscreen/Makefile create mode 100644 fullscreen/test.icl create mode 100644 gencons/Makefile create mode 100644 gencons/test.icl create mode 100644 generic_classes/C.dcl create mode 100644 generic_classes/C.icl create mode 100644 generic_classes/Makefile create mode 100644 generic_classes/test.icl create mode 100644 gopt/gopt.icl create mode 100644 iTasks-notifications/Makefile create mode 100644 iTasks-notifications/test.icl create mode 100644 if/Makefile create mode 100644 if/test.icl create mode 100644 new-external/Makefile create mode 100644 new-external/test.icl create mode 100644 parallel-action/Makefile create mode 100644 parallel-action/test.icl create mode 100644 select/Select.dcl diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0b2e8a0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +*-sapl +*-www +*-data +*.prj +Clean System Files +*.[^l] +*.o +test +gopt diff --git a/append-ed/Makefile b/append-ed/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/append-ed/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/append-ed/test.icl b/append-ed/test.icl new file mode 100644 index 0000000..5c101f5 --- /dev/null +++ b/append-ed/test.icl @@ -0,0 +1,11 @@ +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 diff --git a/documents/Makefile b/documents/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/documents/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/documents/test.icl b/documents/test.icl new file mode 100644 index 0000000..6c4d9dc --- /dev/null +++ b/documents/test.icl @@ -0,0 +1,10 @@ +module test + +import iTasks +import iTasks.Extensions.Document + +Start w = startEngine t w + +t :: Task Document +t = enterInformation "bork" [] + >>= viewInformation "doc" [] diff --git a/dyn/Makefile b/dyn/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/dyn/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/dyn/T.dcl b/dyn/T.dcl new file mode 100644 index 0000000..5b207bc --- /dev/null +++ b/dyn/T.dcl @@ -0,0 +1,10 @@ +definition module T + +import StdGeneric + +:: T + +someT :: T + +class dyn a | TC a +derive class dyn T diff --git a/dyn/T.icl b/dyn/T.icl new file mode 100644 index 0000000..11c0ad2 --- /dev/null +++ b/dyn/T.icl @@ -0,0 +1,8 @@ +implementation module T + +:: T = T + +someT :: T +someT = T + +derive class dyn T diff --git a/dyn/test.icl b/dyn/test.icl new file mode 100644 index 0000000..bddb9bd --- /dev/null +++ b/dyn/test.icl @@ -0,0 +1,5 @@ +module test + +import T + +Start = dynamic someT diff --git a/filepicker/Makefile b/filepicker/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/filepicker/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/filepicker/test.icl b/filepicker/test.icl new file mode 100644 index 0000000..27c5ac0 --- /dev/null +++ b/filepicker/test.icl @@ -0,0 +1,58 @@ +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] diff --git a/foreign/Makefile b/foreign/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/foreign/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/foreign/fac.dcl b/foreign/fac.dcl new file mode 100644 index 0000000..6e02074 --- /dev/null +++ b/foreign/fac.dcl @@ -0,0 +1,3 @@ +definition module fac + +fac :: !Int -> Int diff --git a/foreign/fac.icl b/foreign/fac.icl new file mode 100644 index 0000000..ccf1c28 --- /dev/null +++ b/foreign/fac.icl @@ -0,0 +1,7 @@ +implementation module fac + +import StdEnv + +fac :: !Int -> Int +fac 0 = 1 +fac n = n * fac (n-1) diff --git a/foreign/test.c b/foreign/test.c new file mode 100644 index 0000000..586ac74 --- /dev/null +++ b/foreign/test.c @@ -0,0 +1,9 @@ +#include + +extern int fac(int n); + +int cmain() +{ + for(int i = 0; i<10; i++) + printf("Fac %d: %d\n", i, fac(i)); +} diff --git a/foreign/test.dcl b/foreign/test.dcl new file mode 100644 index 0000000..e4d5512 --- /dev/null +++ b/foreign/test.dcl @@ -0,0 +1,3 @@ +definition module test + +fac :: !Int -> Int diff --git a/foreign/test.icl b/foreign/test.icl new file mode 100644 index 0000000..42bd601 --- /dev/null +++ b/foreign/test.icl @@ -0,0 +1,16 @@ +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 diff --git a/fullscreen/Makefile b/fullscreen/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/fullscreen/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/fullscreen/test.icl b/fullscreen/test.icl new file mode 100644 index 0000000..883ec8f --- /dev/null +++ b/fullscreen/test.icl @@ -0,0 +1,15 @@ +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 () + diff --git a/gencons/Makefile b/gencons/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/gencons/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/gencons/test.icl b/gencons/test.icl new file mode 100644 index 0000000..299b073 --- /dev/null +++ b/gencons/test.icl @@ -0,0 +1,18 @@ +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 = {} diff --git a/generic_classes/C.dcl b/generic_classes/C.dcl new file mode 100644 index 0000000..ccf41ba --- /dev/null +++ b/generic_classes/C.dcl @@ -0,0 +1,10 @@ +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 diff --git a/generic_classes/C.icl b/generic_classes/C.icl new file mode 100644 index 0000000..60a5cb9 --- /dev/null +++ b/generic_classes/C.icl @@ -0,0 +1,7 @@ +implementation module C + +import Text.GenJSON + +derive JSONEncode T +derive JSONDecode T +derive class C T diff --git a/generic_classes/Makefile b/generic_classes/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/generic_classes/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/generic_classes/test.icl b/generic_classes/test.icl new file mode 100644 index 0000000..29a9340 --- /dev/null +++ b/generic_classes/test.icl @@ -0,0 +1,6 @@ +module test + +import C +import Text.GenJSON + +Start = toJSON T diff --git a/gopt/gopt.icl b/gopt/gopt.icl new file mode 100644 index 0000000..69ac02b --- /dev/null +++ b/gopt/gopt.icl @@ -0,0 +1,101 @@ +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 +// | ReqArg (String -> a) String // ^ option requires argument +// | OptArg ((Maybe String) -> a) String // ^ optional argument +// +:: 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{|*|} diff --git a/iTasks-notifications/Makefile b/iTasks-notifications/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/iTasks-notifications/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/iTasks-notifications/test.icl b/iTasks-notifications/test.icl new file mode 100644 index 0000000..d19eccc --- /dev/null +++ b/iTasks-notifications/test.icl @@ -0,0 +1,26 @@ +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) + diff --git a/if/Makefile b/if/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/if/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/if/test.icl b/if/test.icl new file mode 100644 index 0000000..b033747 --- /dev/null +++ b/if/test.icl @@ -0,0 +1,7 @@ +module test + +import Data.Func + +Start = (if` True 42) 52 + +if` c t e :== if c t e diff --git a/new-external/Makefile b/new-external/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/new-external/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/new-external/test.icl b/new-external/test.icl new file mode 100644 index 0000000..03c1c35 --- /dev/null +++ b/new-external/test.icl @@ -0,0 +1,24 @@ +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} diff --git a/parallel-action/Makefile b/parallel-action/Makefile new file mode 100644 index 0000000..83f7745 --- /dev/null +++ b/parallel-action/Makefile @@ -0,0 +1,4 @@ +all: + mkdir -p Clean\ System\ Files + gcc -c test.c -o test.o + clm -l test.o -dynamics -IL Dynamics test -o test diff --git a/parallel-action/test.icl b/parallel-action/test.icl new file mode 100644 index 0000000..8877787 --- /dev/null +++ b/parallel-action/test.icl @@ -0,0 +1,23 @@ +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 ()))] diff --git a/select/Select.dcl b/select/Select.dcl new file mode 100644 index 0000000..f706f7a --- /dev/null +++ b/select/Select.dcl @@ -0,0 +1,7 @@ +definition module Select + +class Selectable a +where + addToSelectSet :: a SelectSet -> SelectSet + +instance -- 2.20.1