msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

uniform encoding: gfo and pgf in UTF8, internal in unicode

Browse Source
This commit is contained in:
aarne
2008-06-26 16:35:45 +00:00
parent 712717e461
commit 7f9a0cdd34
41 changed files with 159 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
src/GF/Command/Commands.hs
View File

@@ -62,10 +62,10 @@ emptyCommandInfo = CommandInfo {
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
lookCommand = Map.lookup
commandHelpAll :: PGF -> [Option] -> String
commandHelpAll pgf opts = unlines
commandHelpAll :: (String -> String) -> PGF -> [Option] -> String
commandHelpAll enc pgf opts = unlines
[commandHelp (isOpt "full" opts) (co,info)
| (co,info) <- Map.assocs (allCommands pgf)]
| (co,info) <- Map.assocs (allCommands enc pgf)]
commandHelp :: Bool -> (String,CommandInfo) -> String
commandHelp full (co,info) = unlines $ [
@@ -81,8 +81,8 @@ commandHelp full (co,info) = unlines $ [
] else []
-- this list must no more be kept sorted by the command name
allCommands :: PGF -> Map.Map String CommandInfo
allCommands pgf = Map.fromList [
allCommands :: (String -> String) -> PGF -> Map.Map String CommandInfo
allCommands enc pgf = Map.fromList [
("cc", emptyCommandInfo {
longname = "compute_concrete",
syntax = "cc (-all | -table | -unqual)? TERM",
@@ -145,7 +145,8 @@ allCommands pgf = Map.fromList [
syntax = "gr [-cat=CAT] [-number=INT]",
examples = [
"gr -- one tree in the startcat of the current grammar",
"gr -cat=NP -number=16 -- 16 trees in the category NP"
"gr -cat=NP -number=16 -- 16 trees in the category NP",
"gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha"
],
explanation = unlines [
"Generates a list of random trees, by default one tree."
@@ -154,7 +155,7 @@ allCommands pgf = Map.fromList [
],
flags = [
("cat","generation category"),
("lang","excludes functions that have no linearization in this language"),
("lang","uses only functions that have linearizations in all these languages"),
("number","number of trees generated")
],
exec = \opts _ -> do
@@ -196,10 +197,10 @@ allCommands pgf = Map.fromList [
],
exec = \opts ts -> return ([], case ts of
[t] -> let co = showTree t in
case lookCommand co (allCommands pgf) of ---- new map ??!!
case lookCommand co (allCommands enc pgf) of ---- new map ??!!
Just info -> commandHelp True (co,info)
_ -> "command not found"
_ -> commandHelpAll pgf opts)
_ -> commandHelpAll enc pgf opts)
}),
("i", emptyCommandInfo {
longname = "import",
@@ -400,6 +401,15 @@ allCommands pgf = Map.fromList [
("number","the maximum number of questions")
]
}),
("se", emptyCommandInfo {
longname = "set_encoding",
synopsis = "set the encoding used in current terminal",
syntax = "se ID",
examples = [
"se cp1251 -- set encoding to cp1521",
"se utf8 -- set encoding to utf8 (default)"
]
}),
("sp", emptyCommandInfo {
longname = "system_pipe",
synopsis = "send argument to a system command",
@@ -407,7 +417,7 @@ allCommands pgf = Map.fromList [
exec = \opts arg -> do
let tmpi = "_tmpi" ---
let tmpo = "_tmpo"
writeFile tmpi $ toString arg
writeFile tmpi $ enc $ toString arg
let syst = optComm opts ++ " " ++ tmpi
system $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo
s <- readFile tmpo
@@ -451,7 +461,7 @@ allCommands pgf = Map.fromList [
let file s = "_grph." ++ s
let view = optViewGraph opts ++ " "
let format = optViewFormat opts
writeFile (file "dot") grph
writeFile (file "dot") (enc grph)
system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format ++
" ; " ++ view ++ file format
return void
@@ -475,8 +485,8 @@ allCommands pgf = Map.fromList [
exec = \opts arg -> do
let file = valIdOpts "file" "_gftmp" opts
if isOpt "append" opts
then appendFile file (toString arg)
else writeFile file (toString arg)
then appendFile file (enc (toString arg))
else writeFile file (enc (toString arg))
return void,
options = [
("append","append to file, instead of overwriting it")
@@ -526,7 +536,8 @@ allCommands pgf = Map.fromList [
in cod : filter (/=cod) (map prOpt opts)
_ -> map prOpt opts
optRestricted opts = restrictPGF (hasLin pgf (mkCId (optLang opts))) pgf
optRestricted opts =
restrictPGF (\f -> and [hasLin pgf (mkCId la) f | la <- optLangs opts]) pgf
optLangs opts = case valIdOpts "lang" "" opts of
"" -> languages pgf

29
src/GF/Command/Interpreter.hs
View File

@@ -17,6 +17,7 @@ import GF.System.Signal
import GF.Infra.UseIO
import GF.Data.ErrM ----
import GF.Text.UTF8
import qualified Data.Map as Map
@@ -27,25 +28,25 @@ data CommandEnv = CommandEnv {
expmacros :: Map.Map String Tree
}
mkCommandEnv :: PGF -> CommandEnv
mkCommandEnv pgf = CommandEnv pgf (allCommands pgf) Map.empty Map.empty
mkCommandEnv :: (String -> String) -> PGF -> CommandEnv
mkCommandEnv enc pgf = CommandEnv pgf (allCommands enc pgf) Map.empty Map.empty
emptyCommandEnv :: CommandEnv
emptyCommandEnv = mkCommandEnv emptyPGF
emptyCommandEnv = mkCommandEnv encodeUTF8 emptyPGF
interpretCommandLine :: CommandEnv -> String -> IO ()
interpretCommandLine env line =
interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO ()
interpretCommandLine enc env line =
case readCommandLine line of
Just [] -> return ()
Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe env) pipes)
Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe enc env) pipes)
case res of
Left ex -> putStrLnFlush (show ex)
Left ex -> putStrLnFlush $ enc (show ex)
Right x -> return x
Nothing -> putStrLnFlush "command not parsed"
interpretPipe env cs = do
interpretPipe enc env cs = do
v@(_,s) <- intercs ([],"") cs
putStrLnFlush s
putStrLnFlush $ enc s
return v
where
intercs treess [] = return treess
@@ -55,12 +56,12 @@ interpretPipe env cs = do
interc es comm@(Command co _ arg) = case co of
'%':f -> case Map.lookup f (commandmacros env) of
Just css -> do
mapM_ (interpretPipe env) (appLine (getCommandArg env arg es) css)
mapM_ (interpretPipe enc env) (appLine (getCommandArg env arg es) css)
return ([],[]) ---- return ?
_ -> do
putStrLn $ "command macro " ++ co ++ " not interpreted"
return ([],[])
_ -> interpret env es comm
_ -> interpret enc env es comm
appLine es = map (map (appCommand es))
-- macro definition applications: replace ?i by (exps !! i)
@@ -75,12 +76,12 @@ appCommand xs c@(Command i os arg) = case arg of
Abs x b -> Abs x (app b)
-- return the trees to be sent in pipe, and the output possibly printed
interpret :: CommandEnv -> [Tree] -> Command -> IO CommandOutput
interpret env trees0 comm = case lookCommand co comms of
interpret :: (String -> String) -> CommandEnv -> [Tree] -> Command -> IO CommandOutput
interpret enc env trees0 comm = case lookCommand co comms of
Just info -> do
checkOpts info
tss@(_,s) <- exec info opts trees
optTrace s
optTrace $ enc s
return tss
_ -> do
putStrLn $ "command " ++ co ++ " not interpreted"