giza alignment in the C shell

1 files changed, 31 insertions, 26 deletions

diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs
index 7fe28ca8d..2621bc9a4 100644
--- a/src/compiler/GF/Command/Commands2.hs
+++ b/src/compiler/GF/Command/Commands2.hs
@@ -35,7 +35,7 @@ import GF.Command.CommandInfo
 import GF.Data.Operations
 
 --import PGF.Internal (encodeFile)
-import Data.List(intersperse,nub)
+import Data.List(intersperse,intersect,nub)
 import Data.Maybe
 import qualified Data.Map as Map
 --import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead!
@@ -72,30 +72,29 @@ pgfCommands = Map.fromList [
        ],
      exec = needPGF $ \opts es env -> do
          let cncs = optConcs env opts
-         {-if isOpt "giza" opts
-           then do
-             let giz = map (H.gizaAlignment pgf (head $ langs, head $ tail $ langs)) es
-             let lsrc = unlines $ map (\(x,_,_) -> x) giz
-             let ltrg = unlines $ map (\(_,x,_) -> x) giz
-             let align = unlines $ map (\(_,_,x) -> x) giz
-             let grph = if null es then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align
-             return $ fromString grph
-           else do-}
-         do  let gvOptions=graphvizDefaults{leafFont = valStrOpts "font" "" opts,
-                                            leafColor = valStrOpts "color" "" opts,
-                                            leafEdgeStyle = valStrOpts "edgestyle" "" opts
-                                           }
-                 grph = if null (toExprs es) then [] else graphvizWordAlignment (map snd cncs) gvOptions (cExpr (head (toExprs es)))
-             if isFlag "view" opts || isFlag "format" opts
-               then do
-                 let file s = "_grph." ++ s
-                 let view = optViewGraph opts
-                 let format = optViewFormat opts
-                 restricted $ writeUTF8File (file "dot") grph
-                 restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
-                 restrictedSystem $ view ++ " " ++ file format
-                 return void
-               else return $ fromString grph,
+         if isOpt "giza" opts
+           then if length cncs == 2
+                  then let giz = map (gizaAlignment pgf (snd (cncs !! 0)) (snd (cncs !! 1)) . cExpr) (toExprs es)
+                           lsrc = unlines $ map (\(x,_,_) -> x) giz
+                           ltrg = unlines $ map (\(_,x,_) -> x) giz
+                           align = unlines $ map (\(_,_,x) -> x) giz
+                           grph = if null (toExprs es) then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align
+                       in return (fromString grph)
+                  else error "For giza alignment you need exactly two languages"
+           else let gvOptions=graphvizDefaults{leafFont = valStrOpts "font" "" opts,
+                                               leafColor = valStrOpts "color" "" opts,
+                                               leafEdgeStyle = valStrOpts "edgestyle" "" opts
+                                              }
+                    grph = if null (toExprs es) then [] else graphvizWordAlignment (map snd cncs) gvOptions (cExpr (head (toExprs es)))
+                in if isFlag "view" opts || isFlag "format" opts
+                     then do let file s = "_grph." ++ s
+                             let view = optViewGraph opts
+                             let format = optViewFormat opts
+                             restricted $ writeUTF8File (file "dot") grph
+                             restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
+                             restrictedSystem $ view ++ " " ++ file format
+                             return void
+                     else return (fromString grph),
      examples = [
        ("gr | aw"                         , "generate a tree and show word alignment as graph script"),
        ("gr | aw -view=\"open\""          , "generate a tree and display alignment on Mac"),
@@ -771,8 +770,14 @@ pgfCommands = Map.fromList [
    showFun pgf f = showFun' f (functionType pgf f)
    showFun' f ty = "fun "++f++" : "++showType [] ty
 
+   gizaAlignment pgf src_cnc tgt_cnc e =
+     let src_res   = alignWords src_cnc e
+         tgt_res   = alignWords tgt_cnc e
+         alignment = [show i++"-"++show j | (i,(_,src_fids)) <- zip [0..] src_res, (j,(_,tgt_fids)) <- zip [0..] tgt_res, not (null (intersect src_fids tgt_fids))]
+     in (unwords (map fst src_res), unwords (map fst tgt_res), unwords alignment)
+
    morphos env opts s =
-     [(s,lookupMorpho concr s) | (lang,concr) <- optConcs env opts]
+     [(s,res) | (lang,concr) <- optConcs env opts, let res = lookupMorpho concr s, not (null res)]
 {-
    mexp xs = case xs of
      t:_ -> Just t