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 b7d2916bbe
commit 6be08d77e0
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.Morphology
import PGF.VisualizeTree import PGF.VisualizeTree
import GF.Compile.Export import GF.Compile.Export
import GF.Infra.Option (noOptions, readOutputFormat) import GF.Infra.Option (noOptions, readOutputFormat, Encoding(..))
import GF.Infra.UseIO import GF.Infra.UseIO
import GF.Data.ErrM ---- import GF.Data.ErrM ----
import PGF.Expr (readTree) import PGF.Expr (readTree)
@@ -66,7 +66,7 @@ emptyCommandInfo = CommandInfo {
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
lookCommand = Map.lookup lookCommand = Map.lookup
commandHelpAll :: String -> PGFEnv -> [Option] -> String commandHelpAll :: Encoding -> PGFEnv -> [Option] -> String
commandHelpAll cod pgf opts = unlines commandHelpAll cod pgf opts = unlines
[commandHelp (isOpt "full" opts) (co,info) [commandHelp (isOpt "full" opts) (co,info)
| (co,info) <- Map.assocs (allCommands cod pgf)] | (co,info) <- Map.assocs (allCommands cod pgf)]
@@ -88,7 +88,7 @@ commandHelp full (co,info) = unlines $ [
type PGFEnv = (PGF, Map.Map Language Morpho) type PGFEnv = (PGF, Map.Map Language Morpho)
-- this list must no more be kept sorted by the command name -- 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 [ allCommands cod env@(pgf, mos) = Map.fromList [
("!", emptyCommandInfo { ("!", emptyCommandInfo {
synopsis = "system command: escape to system shell", synopsis = "system command: escape to system shell",
@@ -704,12 +704,12 @@ stringOpOptions = [
treeOpOptions pgf = [(op,expl) | (op,(expl,_)) <- allTreeOps pgf] 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 translationQuiz cod pgf ig og typ = do
tts <- translationList pgf ig og typ infinity tts <- translationList pgf ig og typ infinity
mkQuiz cod "Welcome to GF Translation Quiz." tts 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 morphologyQuiz cod pgf ig typ = do
tts <- morphologyList pgf ig typ infinity tts <- morphologyList pgf ig typ infinity
mkQuiz cod "Welcome to GF Morphology Quiz." tts 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 PGF.Morphology
import GF.System.Signal import GF.System.Signal
import GF.Infra.UseIO import GF.Infra.UseIO
import GF.Infra.Option
import GF.Data.ErrM ---- import GF.Data.ErrM ----
@@ -29,13 +30,13 @@ data CommandEnv = CommandEnv {
expmacros :: Map.Map String Tree expmacros :: Map.Map String Tree
} }
mkCommandEnv :: String -> PGF -> CommandEnv mkCommandEnv :: Encoding -> PGF -> CommandEnv
mkCommandEnv enc pgf = mkCommandEnv enc pgf =
let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in
CommandEnv pgf mos (allCommands enc (pgf, mos)) Map.empty Map.empty CommandEnv pgf mos (allCommands enc (pgf, mos)) Map.empty Map.empty
emptyCommandEnv :: CommandEnv emptyCommandEnv :: CommandEnv
emptyCommandEnv = mkCommandEnv "utf8" emptyPGF emptyCommandEnv = mkCommandEnv UTF_8 emptyPGF
interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO () interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO ()
interpretCommandLine enc env line = 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.Grammar
import GF.Grammar.Macros import GF.Grammar.Macros
import GF.Text.UTF8 import GF.Text.Coding
import GF.Text.CP1251
import GF.Infra.Modules import GF.Infra.Modules
import GF.Infra.Option import GF.Infra.Option
import GF.Data.Operations import GF.Data.Operations
@@ -11,14 +10,10 @@ import GF.Data.Operations
import Data.Char import Data.Char
encodeStringsInModule :: SourceModule -> SourceModule encodeStringsInModule :: SourceModule -> SourceModule
encodeStringsInModule = codeSourceModule encodeUTF8 encodeStringsInModule = codeSourceModule (encodeUnicode UTF_8)
decodeStringsInModule :: SourceModule -> SourceModule decodeStringsInModule :: SourceModule -> SourceModule
decodeStringsInModule mo = decodeStringsInModule mo = codeSourceModule (decodeUnicode (flag optEncoding (flagsModule mo))) mo
case flag optEncoding (flagsModule mo) of
UTF_8 -> codeSourceModule decodeUTF8 mo
CP_1251 -> codeSourceModule decodeCP1251 mo
_ -> mo
codeSourceModule :: (String -> String) -> SourceModule -> SourceModule codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo))) 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, helpMessage,
-- * Checking specific options -- * Checking specific options
flag, cfgTransform, haskellOption, readOutputFormat, flag, cfgTransform, haskellOption, readOutputFormat,
isLexicalCat, isLexicalCat, encodings,
-- * Setting specific options -- * Setting specific options
setOptimization, setCFGTransform, setOptimization, setCFGTransform,
-- * Convenience methods for checking options -- * Convenience methods for checking options
@@ -77,7 +77,7 @@ data Verbosity = Quiet | Normal | Verbose | Debug
data Phase = Preproc | Convert | Compile | Link data Phase = Preproc | Convert | Compile | Link
deriving (Show,Eq,Ord) 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) deriving (Eq,Ord)
data OutputFormat = FmtPGFPretty data OutputFormat = FmtPGFPretty
@@ -483,7 +483,9 @@ haskellOptionNames =
encodings :: [(String,Encoding)] encodings :: [(String,Encoding)]
encodings = encodings =
[("utf8", UTF_8), [("utf8", UTF_8),
("cp1250", CP_1250),
("cp1251", CP_1251), ("cp1251", CP_1251),
("cp1252", CP_1252),
("latin1", ISO_8859_1) ("latin1", ISO_8859_1)
] ]

5
src/GF/Quiz.hs
View File

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

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

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

25
src/GFI.hs
View File

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