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

fix the handling of flag coding

Browse Source
This commit is contained in:
krasimir
2009-02-23 14:17:16 +00:00
parent ef8b8aa1a3
commit e647de7149
7 changed files with 44 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -17,7 +17,7 @@ import PGF.Data ----
import PGF.Morphology
import PGF.VisualizeTree
import GF.Compile.Export
import GF.Infra.Option (noOptions, readOutputFormat)
import GF.Infra.Option (noOptions, readOutputFormat, Encoding(..))
import GF.Infra.UseIO
import GF.Data.ErrM ----
import PGF.Expr (readTree)
@@ -66,7 +66,7 @@ emptyCommandInfo = CommandInfo {
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
lookCommand = Map.lookup
commandHelpAll :: String -> PGFEnv -> [Option] -> String
commandHelpAll :: Encoding -> PGFEnv -> [Option] -> String
commandHelpAll cod pgf opts = unlines
[commandHelp (isOpt "full" opts) (co,info)
| (co,info) <- Map.assocs (allCommands cod pgf)]
@@ -88,7 +88,7 @@ commandHelp full (co,info) = unlines $ [
type PGFEnv = (PGF, Map.Map Language Morpho)
-- this list must no more be kept sorted by the command name
allCommands :: String -> PGFEnv -> Map.Map String CommandInfo
allCommands :: Encoding -> PGFEnv -> Map.Map String CommandInfo
allCommands cod env@(pgf, mos) = Map.fromList [
("!", emptyCommandInfo {
synopsis = "system command: escape to system shell",
@@ -704,12 +704,12 @@ stringOpOptions = [
treeOpOptions pgf = [(op,expl) | (op,(expl,_)) <- allTreeOps pgf]
translationQuiz :: String -> PGF -> Language -> Language -> Type -> IO ()
translationQuiz :: Encoding -> PGF -> Language -> Language -> Type -> IO ()
translationQuiz cod pgf ig og typ = do
tts <- translationList pgf ig og typ infinity
mkQuiz cod "Welcome to GF Translation Quiz." tts
morphologyQuiz :: String -> PGF -> Language -> Type -> IO ()
morphologyQuiz :: Encoding -> PGF -> Language -> Type -> IO ()
morphologyQuiz cod pgf ig typ = do
tts <- morphologyList pgf ig typ infinity
mkQuiz cod "Welcome to GF Morphology Quiz." tts

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

@@ -16,6 +16,7 @@ import PGF.Macros
import PGF.Morphology
import GF.System.Signal
import GF.Infra.UseIO
import GF.Infra.Option
import GF.Data.ErrM ----
@@ -29,13 +30,13 @@ data CommandEnv = CommandEnv {
expmacros :: Map.Map String Tree
}
mkCommandEnv :: String -> PGF -> CommandEnv
mkCommandEnv :: Encoding -> PGF -> CommandEnv
mkCommandEnv enc pgf =
let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in
CommandEnv pgf mos (allCommands enc (pgf, mos)) Map.empty Map.empty
emptyCommandEnv :: CommandEnv
emptyCommandEnv = mkCommandEnv "utf8" emptyPGF
emptyCommandEnv = mkCommandEnv UTF_8 emptyPGF
interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO ()
interpretCommandLine enc env line =

11
src/GF/Compile/Coding.hs
View File

@@ -2,8 +2,7 @@ module GF.Compile.Coding where
import GF.Grammar.Grammar
import GF.Grammar.Macros
import GF.Text.UTF8
import GF.Text.CP1251
import GF.Text.Coding
import GF.Infra.Modules
import GF.Infra.Option
import GF.Data.Operations
@@ -11,14 +10,10 @@ import GF.Data.Operations
import Data.Char
encodeStringsInModule :: SourceModule -> SourceModule
encodeStringsInModule = codeSourceModule encodeUTF8
encodeStringsInModule = codeSourceModule (encodeUnicode UTF_8)
decodeStringsInModule :: SourceModule -> SourceModule
decodeStringsInModule mo =
case flag optEncoding (flagsModule mo) of
UTF_8 -> codeSourceModule decodeUTF8 mo
CP_1251 -> codeSourceModule decodeCP1251 mo
_ -> mo
decodeStringsInModule mo = codeSourceModule (decodeUnicode (flag optEncoding (flagsModule mo))) mo
codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo)))

6
src/GF/Infra/Option.hs
View File

@@ -17,7 +17,7 @@ module GF.Infra.Option
helpMessage,
-- * Checking specific options
flag, cfgTransform, haskellOption, readOutputFormat,
isLexicalCat,
isLexicalCat, encodings,
-- * Setting specific options
setOptimization, setCFGTransform,
-- * Convenience methods for checking options
@@ -77,7 +77,7 @@ data Verbosity = Quiet | Normal | Verbose | Debug
data Phase = Preproc | Convert | Compile | Link
deriving (Show,Eq,Ord)
data Encoding = UTF_8 | ISO_8859_1 | CP_1251
data Encoding = UTF_8 | ISO_8859_1 | CP_1250 | CP_1251 | CP_1252
deriving (Eq,Ord)
data OutputFormat = FmtPGFPretty
@@ -483,7 +483,9 @@ haskellOptionNames =
encodings :: [(String,Encoding)]
encodings =
[("utf8", UTF_8),
("cp1250", CP_1250),
("cp1251", CP_1251),
("cp1252", CP_1252),
("latin1", ISO_8859_1)
]

5
src/GF/Quiz.hs
View File

@@ -23,6 +23,7 @@ import PGF.ShowLinearize
import GF.Data.Operations
import GF.Infra.UseIO
import GF.Infra.Option
import GF.Text.Coding
import System.Random
@@ -33,7 +34,7 @@ import Data.List (nub)
-- generic quiz function
mkQuiz :: String -> String -> [(String,[String])] -> IO ()
mkQuiz :: Encoding -> String -> [(String,[String])] -> IO ()
mkQuiz cod msg tts = do
let qas = [ (q, mkAnswer cod as) | (q,as) <- tts]
teachDialogue qas msg
@@ -58,7 +59,7 @@ morphologyList pgf ig typ number = do
(pws,i) <- zip ss forms, let (par,ws) = pws !! i]
-- | compare answer to the list of right answers, increase score and give feedback
mkAnswer :: String -> [String] -> String -> (Integer, String)
mkAnswer :: Encoding -> [String] -> String -> (Integer, String)
mkAnswer cod as s =
if (elem (norm s) as)
then (1,"Yes.")

21
src/GF/Text/Coding.hs
View File

@@ -1,20 +1,21 @@
module GF.Text.Coding where
import GF.Infra.Option
import GF.Text.UTF8
import GF.Text.CP1250
import GF.Text.CP1251
import GF.Text.CP1252
encodeUnicode e = case e of
"utf8" -> encodeUTF8
"cp1250" -> encodeCP1250
"cp1251" -> encodeCP1251
"cp1252" -> encodeCP1252
_ -> id
UTF_8 -> encodeUTF8
CP_1250 -> encodeCP1250
CP_1251 -> encodeCP1251
CP_1252 -> encodeCP1252
_ -> id
decodeUnicode e = case e of
"utf8" -> decodeUTF8
"cp1250" -> decodeCP1250
"cp1251" -> decodeCP1251
"cp1252" -> decodeCP1252
_ -> id
UTF_8 -> decodeUTF8
CP_1250 -> decodeCP1250
CP_1251 -> decodeCP1251
CP_1252 -> decodeCP1252
_ -> id

25
src/GFI.hs
View File

@@ -21,6 +21,7 @@ import PGF.Macros
import PGF.Expr (readTree)
import Data.Char
import Data.Maybe
import Data.List(isPrefixOf)
import qualified Data.Map as Map
import qualified Text.ParserCombinators.ReadP as RP
@@ -140,15 +141,19 @@ loop opts gfenv0 = do
"ph":_ ->
mapM_ (putStrLn . enc) (reverse (history gfenv0)) >> loopNewCPU gfenv
"se":c:_ -> do
"se":c:_ ->
case lookup c encodings of
Just cod -> do
#ifdef mingw32_HOST_OS
case c of
'c':'p':c -> case reads c of
[(cp,"")] -> setConsoleCP cp >> setConsoleOutputCP cp
_ -> return ()
_ -> return ()
case c of
'c':'p':c -> case reads c of
[(cp,"")] -> setConsoleCP cp >> setConsoleOutputCP cp
_ -> return ()
_ -> return ()
#endif
loopNewCPU $ gfenv {coding = c}
loopNewCPU $ gfenv {coding = cod}
Nothing -> do putStrLn "unknown encoding"
loopNewCPU gfenv
-- ordinary commands, working on CommandEnv
_ -> do
@@ -208,16 +213,16 @@ data GFEnv = GFEnv {
commandenv :: CommandEnv,
history :: [String],
cputime :: Integer,
coding :: String
coding :: Encoding
}
emptyGFEnv :: IO GFEnv
emptyGFEnv = do
#ifdef mingw32_HOST_OS
codepage <- getACP
let coding = "cp"++show codepage
let coding = fromMaybe UTF_8 (lookup ("cp"++show codepage) encodings)
#else
let coding = "utf8"
let coding = UTF_8
#endif
return $ GFEnv emptyGrammar (mkCommandEnv coding emptyPGF) [] 0 coding