From 05377a9a65ec8c67ded279b801d97a7e1354fd2e Mon Sep 17 00:00:00 2001
From: bringert <bringert@cs.chalmers.se>
Date: Fri, 20 Jan 2006 18:18:49 +0000
Subject: [PATCH] Report errors in at command.

---
 src/GF/API.hs                   | 13 +++++++------
 src/GF/Shell.hs                 | 10 +++++-----
 transfer/examples/widesnake.tra |  2 ++
 3 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/src/GF/API.hs b/src/GF/API.hs
index 906bd062f..9ad5c7a3f 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -372,17 +372,18 @@ wrapByFun opts gr f t =
    g = grammar gr
 
 applyTransfer :: Options -> GFGrammar -> [(Ident,T.Env)] ->
-                 (Maybe Ident,Ident) -> Tree -> Tree
-applyTransfer opts gr trs (mm,f) t = 
-  err (const t) id $ annotate g t'
+                 (Maybe Ident,Ident) -> Tree -> Err [Tree]
+applyTransfer opts gr trs (mm,f) t = mapM (annotate g) ts'
  where
-   t' = qualifTerm (absId gr) $ trans tr f $ tree2exp t
+   ts' = map (qualifTerm (absId gr)) $ trans tr f $ tree2exp t
    g = grammar gr
    tr = case mm of
      Just m -> maybe empty id $ lookup m trs
      _ -> ifNull empty (snd . head) trs
-
-   trans tr f = core2exp . T.evaluateExp tr . exp2core f
+   -- FIXME: if the returned value is a list,
+   -- return a list of trees
+   trans :: T.Env -> Ident -> Exp -> [Exp]
+   trans tr f = (:[]) . core2exp . T.evaluateExp tr . exp2core f
    empty = T.builtin
 
 {-
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 417f01215..36dfc5b14 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -298,10 +298,10 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
         g3 = return () ---- system "rm -f grphtmp.*"
     justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa
 
-  CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro)  . s2t) sa
+  CPutTerm -> changeArg (opTT2CommandArg (return . optTermCommand opts gro) . s2t) sa
 
-  CWrapTerm f -> changeArg (opTT2CommandArg (return . wrapByFun opts gro f) . s2t) sa
-  CApplyTransfer f -> changeArg (opTT2CommandArg (return . applyTransfer opts gro transfs f) . s2t) sa
+  CWrapTerm f -> changeArg (opTT2CommandArg (return . return . wrapByFun opts gro f) . s2t) sa
+  CApplyTransfer f -> changeArg (opTT2CommandArg (applyTransfer opts gro transfs f) . s2t) sa
   CMorphoAnalyse -> changeArg (AString . morphoAnalyse opts gro . prCommandArg) sa
   CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
 
@@ -498,7 +498,7 @@ opTS2CommandArg f (ATrms ts) = AString $ unlines $ map f ts
 opTS2CommandArg _ (AError s) = AError ("expected term, but got error:" ++++ s)
 opTS2CommandArg _ a = AError ("expected term, but got:" ++++ prCommandArg a)
 
-opTT2CommandArg :: (Tree -> [Tree]) -> CommandArg -> CommandArg
-opTT2CommandArg f (ATrms ts) = ATrms $ concat $ map f ts
+opTT2CommandArg :: (Tree -> Err [Tree]) -> CommandArg -> CommandArg
+opTT2CommandArg f (ATrms ts) = err AError (ATrms . concat) $ mapM f ts
 opTT2CommandArg _ (AError s) = AError ("expected term, but got error:" ++++ s)
 opTT2CommandArg _ a = AError ("expected term, but got:" ++++ prCommandArg a)
diff --git a/transfer/examples/widesnake.tra b/transfer/examples/widesnake.tra
index 8b2a199c2..f68ed9013 100644
--- a/transfer/examples/widesnake.tra
+++ b/transfer/examples/widesnake.tra
@@ -17,3 +17,5 @@ wideSnake _ x = case x of
                                in if isSnake CN y' then Thick y' else Wide y'
 		    _ -> composOp ? ? compos_Tree ? wideSnake x
 		
+wideSnakeNP : Tree NP -> Tree NP
+wideSnakeNP = wideSnake NP