Verified Commit 244e8aed authored by Camil Staps's avatar Camil Staps 🚀

Use System.Options in builddb and CloogleServer

parent 9b402b20
......@@ -13,8 +13,12 @@ import StdTuple
from TCPIP import :: IPAddress, :: Port, instance toString IPAddress
import Clean.Types
import Clean.Types.Parse
import Clean.Types.Unify
import Clean.Types.Util
import Control.Applicative
import Control.Monad
import Control.Monad => qualified join
import Data.Error
import qualified Data.Foldable as Foldable
from Data.Foldable import class Foldable
......@@ -25,15 +29,11 @@ import Data.Maybe
import Data.Tuple
import System._Posix
import System.CommandLine
import System.Options
import System.Time
from Text import class Text(concat,toLowerCase), instance Text String, <+
from Text import class Text(concat,join,toLowerCase), instance Text String, <+
import Text.GenJSON
import Clean.Types
import Clean.Types.Parse
import Clean.Types.Unify
import Clean.Types.Util
import Cloogle.API
import Cloogle.DB
import Cloogle.Search
......@@ -114,7 +114,6 @@ where
:: Options =
{ port :: !Int
, help :: !Bool
, reload_cache :: !Bool
, test_file :: !Maybe FilePath
, test_options :: ![TestOption]
......@@ -126,35 +125,45 @@ instance zero Options
where
zero =
{ port = 31215
, help = False
, reload_cache = False
, test_file = Nothing
, test_options = []
}
parseOptions :: Options [String] -> MaybeErrorString Options
parseOptions opt [] = Ok opt
parseOptions opt ["-p":p:rest] = case (toInt p, p) of
(0, "0") -> Error "Cannot use port 0"
(0, p) -> Error $ "'" <+ p <+ "' is not an integer"
(p, _) -> parseOptions {Options | opt & port=p} rest
parseOptions opt ["--help":rest] = parseOptions {opt & help=True} rest
parseOptions opt ["--reload-cache":rest] = parseOptions {opt & reload_cache=True} rest
parseOptions opt ["--test":file:rest] = parseOptions {opt & test_file=Just file} rest
parseOptions opt ["--test"] = Error "--test requires an argument"
parseOptions opt ["--test-no-unify":rest] = parseOptions {opt & test_options=[NoUnify:opt.test_options]} rest
parseOptions opt [arg:_] = Error $ "Unknown option '" <+ arg <+ "'"
optionDescription :: Option Options
optionDescription = WithHelp True $ Options
[ Shorthand "-p" "--port" $ Option
"--port"
(\port opts -> case (toInt port, port) of
(0, "0") -> Error ["Cannot use port 0"]
(0, p) -> Error ["'" <+ p <+ "' is not an integer"]
(p, _) -> Ok {Options | opts & port=p})
"PORT"
"Listen on port PORT (default: 31215)"
, Flag
"--reload-cache"
(\opts -> Ok {opts & reload_cache=True})
"Reload the cache in the background"
, Option
"--test"
(\file opts -> Ok {opts & test_file=Just file})
"FILE"
"Load queries from FILE and execute them (do not start a TCP server)"
, Flag
"--test-no-unify"
(\opts -> Ok {opts & test_options=[NoUnify:opts.test_options]})
"Do not test queries that require unification (only used with --test)"
]
Start w
# (cmdline, w) = getCommandLine w
# opts = parseOptions zero (tl cmdline)
# ([prog:args], w) = getCommandLine w
# opts = parseOptions optionDescription args zero
| isError opts
# (io,w) = stdio w
# io = io <<< fromError opts <<< "\n"
# io = io <<< join "\n" (fromError opts) <<< "\n"
# (_,w) = fclose io w
= w
# opts = fromOk opts
| opts.help = help (hd cmdline) w
# w = disableSwap w
#! (_,f,w) = fopen "types.json" FReadText w
#! (db,f) = openDB f
......@@ -183,12 +192,6 @@ Start w
, keepalive_timeout = Just 5000 // 5s
} db w
where
help :: String *World -> *World
help pgm w
# (io, w) = stdio w
# io = io <<< "Usage: " <<< pgm <<< " [--reload-cache] [-p <port>] [-h] [--help]\n"
= snd $ fclose io w
disableSwap :: *World -> *World
disableSwap w
# (ok,w) = mlockall (MCL_CURRENT bitor MCL_FUTURE) w
......
......@@ -9,6 +9,7 @@ import StdMisc
import StdString
import StdTuple
import Clean.Types
import Control.Monad => qualified join
import Data.Either
import Data.Error
......@@ -18,10 +19,10 @@ import Data.List
import Data.Maybe
import System.CommandLine
import System.File
import System.Options
from Text import class Text(join,startsWith), instance Text String
import Text.GenJSON
import Clean.Types
import Cloogle.DB
from Cloogle.DB.Factory import :: TemporaryDB, newTemporaryDB, finaliseDB,
findModules, indexModule, constructor_functions, record_functions,
......@@ -31,65 +32,68 @@ import Builtin.ABC
import Builtin.Predef
import Builtin.Syntax
:: CLI =
{ help :: !Bool
, root :: !String
:: Options =
{ root :: !String
, libs_file :: !String
}
derive JSONDecode IndexItem, SourceURL, PathPattern
instance zero CLI
instance zero Options
where
zero =
{ help = False
, root = "/opt/clean/lib/"
{ root = "/opt/clean/lib/"
, libs_file = "libs.json"
}
USAGE :== join "\n"
[ "Cloogle builddb\n"
, "Usage: ./builddb [opts] > types.json\n"
, "Options:"
, " --help Show this help"
, " -r PATH Change the library root to PATH (default: /opt/clean/lib)"
, " -l PATH Use PATH for a list of libraries to index (default: libs.json)"
, ""]
optionDescription :: Option Options
optionDescription = WithHelp True $ Options
[ Shorthand "-r" "--root" $ Option
"--root"
(\dir opts -> Ok {opts & root=dir})
"PATH"
"Use PATH as the root directory for libraries (default: /opt/clean/lib)"
, Shorthand "-l" "--libraries" $ Option
"--libraries"
(\file opts -> Ok {opts & libs_file=file})
"FILE"
"Use FILE for a list of libraries to index (default: libs.json)"
]
Start :: *World -> *World
Start w
# (args, w) = getCommandLine w
# (f, w) = stdio w
# (ok, w) = case parseCLI (tl args) of
(Left e) = fclose (f <<< e) w
(Right cli)
| cli.help = fclose (f <<< USAGE) w
# (libsf, w) = readFile cli.libs_file w
# libsjson = fromString $ fromOk libsf
# libs = case libsjson of
JSONObject groups -> sequence $ [fromJSON i \\ (_,JSONArray g) <- groups, i <- g]
_ -> Nothing
| isError libsf || isNothing libs
# err = stderr <<< "Could not read " <<< cli.libs_file <<< "\n"
# (_,w) = fclose err w
= fclose f w
# libs = fromJust libs
# (mods, w) = mapSt (flip (findModules cli.root) "") libs w
# mods = flatten mods
#! (db, w) = loop cli.root mods newTemporaryDB w
#! (ok,w) = fclose (stderr <<< "Linking database entries; this may take up to 10 minutes...\n") w
| not ok = abort "Couldn't close stderr\n"
#! db = finaliseDB builtins db
#! (db,err) = printStats db stderr
#! (ok1,w) = fclose err w
#! (db,f) = saveDB db f
#! (ok2,w) = fclose f w
#! (_,dbg,w) = fopen "typetree.dot" FWriteText w
#! (db,dbg) = writeTypeTree db dbg
#! (_,w) = fclose dbg w
= (ok1 && ok2,w)
| not ok = abort "Couldn't close stdio\n"
# ([prog:args], w) = getCommandLine w
# opts = parseOptions optionDescription args zero
| isError opts
# f = f <<< join "\n" (fromError opts) <<< "\n"
# (_,w) = fclose f w
= w
# opts = fromOk opts
# (libsf, w) = readFile opts.libs_file w
# libsjson = fromString $ fromOk libsf
# libs = case libsjson of
JSONObject groups -> sequence $ [fromJSON i \\ (_,JSONArray g) <- groups, i <- g]
_ -> Nothing
| isError libsf || isNothing libs
# err = stderr <<< "Could not read " <<< opts.libs_file <<< "\n"
# (_,w) = fclose err w
# (_,w) = fclose f w
= w
# libs = fromJust libs
# (mods, w) = mapSt (flip (findModules opts.root) "") libs w
# mods = flatten mods
#! (db, w) = loop opts.root mods newTemporaryDB w
#! (ok,w) = fclose (stderr <<< "Linking database entries; this may take up to 10 minutes...\n") w
| not ok = abort "Couldn't close stderr\n"
#! db = finaliseDB builtins db
#! (db,err) = printStats db stderr
#! (ok1,w) = fclose err w
#! (db,f) = saveDB db f
#! (ok2,w) = fclose f w
#! (_,dbg,w) = fopen "typetree.dot" FWriteText w
#! (db,dbg) = writeTypeTree db dbg
#! (_,w) = fclose dbg w
= w
where
loop :: String [ModuleEntry] !TemporaryDB !*World -> *(!TemporaryDB, !*World)
......@@ -112,16 +116,6 @@ where
map SyntaxEntry builtin_syntax ++
map ABCInstructionEntry builtin_abc_instructions
parseCLI :: [String] -> Either String CLI
parseCLI [] = Right zero
parseCLI [x:a] = case (x,a) of
("--help", xs) = (\c->{c & help=True}) <$> parseCLI xs
("-r", []) = Left "'-r' requires an argument"
("-r", [x:xs]) = (\c->{c & root=x}) <$> parseCLI xs
("-l", []) = Left "'-l' requires an argument"
("-l", [x:xs]) = (\c->{c & libs_file=x}) <$> parseCLI xs
(x, _) = Left $ "Unknown option '" +++ x +++ "'"
printStats :: !*CloogleDB !*File -> *(*CloogleDB, *File)
printStats db f
# (s,db) = dbStats db
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment