oops, forgot add Coding

1 files changed, 55 insertions, 0 deletions

diff --git a/src/GF/Compile/Coding.hs b/src/GF/Compile/Coding.hs
new file mode 100644
index 000000000..9d271964f
--- /dev/null
+++ b/src/GF/Compile/Coding.hs
@@ -0,0 +1,55 @@
+module GF.Compile.Coding where
+
+import GF.Grammar.Grammar
+import GF.Grammar.Macros
+import GF.Text.UTF8
+import GF.Infra.Modules
+import GF.Infra.Option
+import GF.Data.Operations
+
+import Data.Char
+
+encodeStringsInModule :: SourceModule -> SourceModule
+encodeStringsInModule = codeSourceModule encodeUTF8
+
+decodeStringsInModule :: SourceModule -> SourceModule
+decodeStringsInModule mo = case mo of
+  (_,ModMod m) -> case moduleFlag optEncoding (moduleOptions (flags m)) of
+    UTF_8   -> codeSourceModule decodeUTF8 mo
+    CP_1251 -> codeSourceModule decodeCP1251 mo
+    _ -> mo
+  _ -> mo
+
+codeSourceModule :: (String -> String) -> SourceModule ->  SourceModule
+codeSourceModule co (id,moi) = case moi of
+  ModMod mo -> (id, ModMod $ replaceJudgements mo (mapTree codj (jments mo)))
+  _ -> (id,moi)
+ where
+    codj (c,info) = (c, case info of
+      ResOper     pty pt  -> ResOper (mapP codt pty) (mapP codt pt) 
+      ResOverload es tyts -> ResOverload es [(codt ty,codt t) | (ty,t) <- tyts]
+      CncCat pty pt mpr   -> CncCat pty (mapP codt pt) (mapP codt mpr)
+      CncFun mty pt mpr   -> CncFun mty (mapP codt pt) (mapP codt mpr)
+      _ -> info
+      )
+    codt t = case t of
+      K s -> K (co s)
+      T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
+      _ -> composSafeOp codt t
+    codp p = case p of  --- really: composOpPatt
+      PR rs -> PR [(l,codp p) | (l,p) <- rs]
+      PString s -> PString (co s)
+      PChars s -> PChars (co s)
+      PT x p -> PT x (codp p)
+      PAs x p -> PAs x (codp p)
+      PNeg p -> PNeg (codp p)
+      PRep p -> PRep (codp p)
+      PSeq p q -> PSeq (codp p) (codp q)
+      PAlt p q -> PAlt (codp p) (codp q)
+      _ -> p
+
+---- from Text.Lexing
+decodeCP1251 = map convert where
+  convert c
+   | c >= '\192' && c <= '\255' = chr (ord c + 848)
+   | otherwise                  = c