CreateBasicAPIExamples.icl 1.96 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 37 38 39 40 41 42 43 44 45 46 47 48
	[ "module BasicAPIExamples\n"
	, "\n"
	, "import iTasks"
	, "\n"
	, join "\n" ["import qualified " +++ toDots i\\i<-i]
	, "\n\n"
	, "Start :: *World -> *World\n"
	, "Start world = startEngine\n"
	, "\t[ publish \"/\" (\\_->loginAndManageWorkList title basicAPIExamples <<@ ApplyLayout (setUIAttributes (titleAttr title)))\n"
	, "\t] world\n"
	, "where\n"
	, "\ttitle = \"iTasks Example Collection\"\n"
	, "\n"
	, "basicAPIExamples :: [Workflow]\n"
Mart Lubbers's avatar
Mart Lubbers committed
49
	, "basicAPIExamples =\n"
50 51 52 53 54 55 56 57
	, "\t[",join "\n\t," (map (\i->concat ["'", toDots i, "'.wf \"", toString (insertSpaces 0 (dropExtension i)), "\""]) i), "\n\t]\n"]
where
	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
58 59 60

Start w
# (io, w) = stdio w
61
# (mcwd, w) = recurse "BasicAPIExamples" w
Mart Lubbers's avatar
Mart Lubbers committed
62 63 64 65
| 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"
66
= w