CreateBasicAPIExamples.icl 1.83 KB
Newer Older
Mart Lubbers's avatar
Mart Lubbers committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
module CreateBasicAPIExamples

import StdFile, StdBool, StdMisc, StdFunc, StdList, StdString, StdTuple
import Control.Monad => qualified join
import Control.Applicative
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

:: IOT t a = IOT .(*World -> *(t a, *World))

runIOT (IOT i) = i

instance Functor (IOT t) | Functor t
where
	fmap f m = IOT (appFst (fmap f) o runIOT m)
instance Applicative (IOT t) | Applicative t
where
	pure a = IOT (tuple (pure a))
	(<*>) mf ma = IOT \w->
		let (f, w`) = runIOT mf w in appFst ((<*>) f) (runIOT ma w`)
instance Monad (IOT (MaybeError e))
where
	bind ma a2mb = IOT \w->case runIOT ma w of
		(Error e, w) = (Error e, w)
		(Ok a, w) = runIOT (a2mb a) w
//seqErrorsSt :: !(.st -> (MaybeError e a,!.st)) (a .st -> u:(!MaybeError e b, !.st)) !.st -> v:(MaybeError e b, !.st), [u <= v]	

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

recurse :: FilePath -> IOT (MaybeError OSError) [FilePath]
recurse root
	| endsWith ".dcl" root = pure [root]
	= IOT (getFileInfo root) >>= \fi->if fi.directory
		(IOT (readDirectory root)
			>>= fmap flatten o mapM (recurse o (</>) root) o filter filterDirs)
		(pure [])

makeExs :: [FilePath] -> [String]
makeExs i = 
	[ "basicAPIExamples :: [Workflow]\n"
	, "basicAPIExamples =\n"
	, "\t[",join "\n\t," (map makeEx i), "\n\t]\n"]
makeEx i = concat ["workflow \"", i, "\" '", i, "'.doc '", i, "'.workflow"]

Start w
# (io, w) = stdio w
# (mcwd, w) = runIOT (recurse "BasicAPIExamples") w
| 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"
= (w, mcwd)