module clpm from StdFunc import flip, o import StdFile import StdList import StdOverloaded import StdString import StdTuple import Control.Applicative import Control.Monad import Data.Error from Data.Func import $ import Data.Functor import Data.Maybe import Data.Tuple from Text import instance + String import Text.JSON import System.CommandLine import System.Directory import System.File import CLPM.Package import CLPM.Repository :: Action = NoAction | Install | Make :: Arguments = { package_file :: String , action :: Action , repository :: String , clm_options :: [String] } instance zero Arguments where zero = { package_file = PACKAGE_FILE , action = NoAction , repository = REPOSITORY , clm_options = [] } Start w # (io,w) = stdio w # ((missed, args), w) = appFst (parseArgs [] zero o tl) $ getCommandLine w | not (isEmpty missed) # io = foldr (flip (<<<)) io ["Unknown option: " + m + "\n" \\ m <- missed] # (_,w) = fclose io w = w # (pkg,w) = readPackage args.package_file w | isError pkg # io = io <<< fromError pkg <<< "\n" # (_,w) = fclose io w = w # (Ok pkg) = pkg # (io,w) = do args pkg io w # (_,w) = fclose io w = w do :: Arguments Package *File *World -> *(*File, *World) do args pkg io w = case args.action of NoAction = (io,w) Install = install pkg io w Make = make args.clm_options pkg io w install :: Package *File *World -> *(*File, *World) install pkg io w # (e,w) = fileExists MODULE_DIR w # w = if e w (snd $ createDirectory MODULE_DIR w) # (repo,w) = getRepository REPOSITORY w | isError repo = (io <<< fromError repo <<< "\n", w) # (Ok repo) = repo # io = foldl printRepo io repo # solv = resolveDependencies repo pkg | isError solv = (io <<< fromError solv <<< "\n", w) # (Ok solv) = solv # io = io <<< "Dependencies:\n" # io = printDeps io solv = (io,w) where printRepo :: *File RepositoryItem -> *File printRepo f ri = f <<< ri.RepositoryItem.name <<< "\t" <<< foldl (+++) "" [toString v.RepositoryItemVersion.version + ", " \\ v <- ri.RepositoryItem.versions] <<< "\n" printDeps :: *File [(Dependency, Version)] -> *File printDeps f ds = foldl (<<<) f [depName d + "\t" + toString v + "\n" \\ (d,v) <- ds] make :: [String] Package *File *World -> *(*File, *World) make opts pkg io w # (ps,w) = getRecursivePaths pkg w | isError ps = (io <<< fromError ps <<< "\n", w) # ps = fromOk ps # (r,w) = syscall (foldl (+) "clm" [" -I " + p \\ p <- ps] + foldl (+) "" [" " + f \\ f <- optionsToFlags pkg.options ++ opts] + " " + pkg.main + " -o " + pkg.main) w = (io,w) parseArgs :: [String] Arguments [String] -> ([String], Arguments) parseArgs miss args [] = (miss, args) parseArgs miss args ["-p":name:rest] = parseArgs miss {args & package_file = name} rest parseArgs miss args ["-r":repo:rest] = parseArgs miss {args & repository = repo} rest parseArgs miss args ["-c":opt:rest] = parseArgs miss {args & clm_options = args.clm_options ++ [opt]} rest parseArgs miss args ["install":rest] = parseArgs miss {args & action = Install} rest parseArgs miss args ["make":rest] = parseArgs miss {args & action = Make} rest parseArgs miss args [a:rest] = parseArgs [a:miss] args rest syscall :: !String !*World -> !*(!Int, !*World) syscall cmd w = code { ccall system "s:I:A" }