From 95f1d40c5636d6e9ba8d4877d044b83f41bbbf65 Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Wed, 7 Jul 2010 12:23:21 +0000
Subject: [PATCH] report type errors in the shell from command "p"

---
 src/compiler/GF/Command/Commands.hs     | 24 ++++++++++++++----------
 src/compiler/GF/Compile/ExampleBased.hs |  2 +-
 src/runtime/haskell/PGF/Parse.hs        |  5 +++--
 3 files changed, 18 insertions(+), 13 deletions(-)

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 6f3700032..54bcb9e70 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -482,7 +482,7 @@ allCommands env@(pgf, mos) = Map.fromList [
        "will accept unknown adjectives, nouns and verbs with the resource grammar."
        ],
      exec = \opts ts -> 
-              return $ fromParse opts ts $ concatMap (par opts) $ toStrings ts,
+              return $ fromParse opts (concat [map ((,) s) (par opts s) | s <- toStrings ts]),
      flags = [
        ("cat","target category of parsing"),
        ("lang","the languages of parsing (comma-separated, no spaces)"),
@@ -1003,16 +1003,20 @@ allCommands env@(pgf, mos) = Map.fromList [
    toStrings = map showAsString 
    toString = unwords . toStrings
 
-   fromParse opts ts parses
-     | isOpt "bracket" opts = ([], unlines $ map showBracketedString bss)
-     | otherwise            = case ts of
-                                [] -> ([], "no trees found" ++ 
-                                           missingWordMsg (optMorpho opts) (concatMap words (toStrings ts))
-                                      )
-                                _  -> fromExprs ts
+   fromParse opts []     = ([],"")
+   fromParse opts ((s,(po,bs)):ps)
+     | isOpt "bracket" opts = (es, showBracketedString bs
+                                   ++ "\n" ++ msg)
+     | otherwise            = case po of
+                                ParseOk ts     -> let (es',msg') = fromExprs ts
+                                                  in (es'++es,msg'++msg)
+                                TypeError errs -> ([], render (text "The parsing is successful but the type checking failed with error(s):" $$ 
+                                                               nest 2 (vcat (map (ppTcError . snd) errs)))
+                                                       ++ "\n" ++ msg)
+                                ParseFailed i  -> ([], "parse failed at token " ++ show (words s !! max 0 (i-1))
+                                                       ++ "\n" ++ msg)
      where
-       (prs,bss) = unzip parses
-       ts        = [t | ParseOk ts <- prs, t <- ts]
+       (es,msg) = fromParse opts ps
 
    returnFromExprs es = return $ case es of
      [] -> ([], "no trees found")
diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs
index 199d1e375..74a07426f 100644
--- a/src/compiler/GF/Compile/ExampleBased.hs
+++ b/src/compiler/GF/Compile/ExampleBased.hs
@@ -49,7 +49,7 @@ convertFile conf src file = do
           [] -> return ()
           _  -> appv ("  missing words: " ++ unwords ws)
         return ws
-      TypeError _ _ ->
+      TypeError _ ->
         return []
       ParseOk ts ->
         case rank ts of
diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs
index 1d09359ed..6bf0979a4 100644
--- a/src/runtime/haskell/PGF/Parse.hs
+++ b/src/runtime/haskell/PGF/Parse.hs
@@ -44,11 +44,12 @@ data ParseInput
 -- | This data type encodes the different outcomes which you could get from the parser.
 data ParseOutput
   = ParseFailed Int                -- ^ The integer is the position in number of tokens where the parser failed.
-  | TypeError   FId [TcError]      -- ^ The parsing was successful but none of the trees is type correct. 
+  | TypeError   [(FId,TcError)]    -- ^ The parsing was successful but none of the trees is type correct. 
                                    -- The forest id ('FId') points to the bracketed string from the parser
                                    -- where the type checking failed. More than one error is returned
                                    -- if there are many analizes for some phrase but they all are not type correct.
-  | ParseOk [Tree]                 -- ^ If the parsing was successful we get a list of abstract syntax trees. The list should be non-empty.
+  | ParseOk [Tree]                 -- ^ If the parsing and the type checkeing are successful we get a list of abstract syntax trees.
+                                   -- The list should be non-empty.
 
 parse :: PGF -> Language -> Type -> [Token] -> (ParseOutput,BracketedString)
 parse pgf lang typ toks = loop (initState pgf lang typ) toks