CreateBasicAPIExamples.icl 2.71 KB
Newer Older
Mart Lubbers's avatar
Mart Lubbers committed
1 2
module CreateBasicAPIExamples

3
import StdEnv
Mart Lubbers's avatar
Mart Lubbers committed
4 5 6 7 8 9 10 11 12 13 14
import Data.Functor
import Data.Func
import Data.Error
import Data.Maybe
import Data.Tuple
import System.FilePath
import System.File
import System.Directory
import System.OSError
import Text

15 16
(>>=) infixl 1
(>>=) :== seqErrorsSt
Mart Lubbers's avatar
Mart Lubbers committed
17 18 19 20 21 22

filterDirs :: FilePath -> Bool
filterDirs "." = False
filterDirs ".." = False
filterDirs _ = True

23 24 25 26
seq [] = tuple (Ok [])
seq [e:es] = e >>= \a->seq es >>= \as->tuple (Ok [a:as])

recurse :: FilePath -> .(*World -> *(MaybeError OSError [FilePath], !*World))
Mart Lubbers's avatar
Mart Lubbers committed
27
recurse root
28 29 30 31
	| endsWith ".dcl" root = tuple (Ok [root])
	= getFileInfo root >>= \fi->if fi.directory
			(readDirectory root >>= ((o) (appFst (fmap flatten))) o seq o map (recurse o (</>)root) o filter filterDirs)
			(tuple (Ok []))
Mart Lubbers's avatar
Mart Lubbers committed
32 33

makeExs :: [FilePath] -> [String]
34
makeExs i =
35 36
	[ "module BasicAPIExamples\n"
	, "\n"
37
	, "import iTasks\n"
38
	, "import Text.HTML\n"
39
	, "import qualified iTasks.Extensions.Admin.UserAdmin\n"
40 41 42 43
	, "\n"
	, join "\n" ["import qualified " +++ toDots i\\i<-i]
	, "\n\n"
	, "Start :: *World -> *World\n"
44
	, "Start world = doTasks {WorkflowCollection|name=name,welcomeMessage=Just message,workflows=basicAPIExamples} world\n"
45
	, "where\n"
46
	, "\tname = \"iTasks Example Collection\"\n"
47 48 49 50 51 52 53 54 55 56 57
	, "\tmessage = DivTag []\n"
	, "\t\t[Text \"If you want to try the examples in a multi user setting, you can log in with one of the demo users\"\n"
	, "\t\t,BrTag []\n"
	, "\t\t,Text \"For example:\"\n"
	, "\t\t\t,UlTag []\n"
	, "\t\t\t\t[LiTag [] [Text \"Administrator (username: root, password: root)\"]\n"
	, "\t\t\t\t,LiTag [] [Text \"Alice (username: alice, password: alice)\"]\n"
	, "\t\t\t\t,LiTag [] [Text \"Bob (username: bob, password: bob)\"]\n"
	, "\t\t\t\t,LiTag [] [Text \"Carol (username: carol, password: carol)\"]\n"
	, "\t\t\t\t]\n"
	, "\t\t\t]\n"
58 59
	, "\n"
	, "basicAPIExamples :: [Workflow]\n"
Mart Lubbers's avatar
Mart Lubbers committed
60
	, "basicAPIExamples =\n"
61
	, "\t[",join "\n\t," (defaultWfs ++ exampleWfs), "\n\t]\n"]
62
where
63 64
	defaultWfs = ["restrictedTransientWorkflow \"Users\" \"User management\" [\"admin\"] 'iTasks.Extensions.Admin.UserAdmin'.manageUsers"]
	exampleWfs = map (\i->concat ["'", toDots i, "'.wf \"", toString (insertSpaces 0 (dropExtension i)), "\""]) i
65 66 67 68 69 70
	toDots = join "." o split (toString pathSeparator) o dropExtension
	insertSpaces i s
		| i == size s = []
		| s % (i, i+2) == "API" = [' ','A','P','I':insertSpaces (i+3) s]
		| isUpper s.[i] && (i == 0  || s.[i-1] <> '/') = [' ',s.[i]:insertSpaces (i+1) s]
		= [s.[i]:insertSpaces (i+1) s]
Mart Lubbers's avatar
Mart Lubbers committed
71 72 73

Start w
# (io, w) = stdio w
74
# (mcwd, w) = recurse "BasicAPIExamples" w
Mart Lubbers's avatar
Mart Lubbers committed
75 76 77 78
| isError mcwd = abort ("Error in getting the files: " +++ toString (snd (fromError mcwd)) +++ "\n")
# io = foldl (<<<) io (makeExs (fromOk mcwd))
# (ok, w) = fclose io w
| not ok = abort "Couldn't close stdio\n"
79
= w