From 8742ebee38281d8c8888e77a5a3e7b5ceb38b56f Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Fri, 30 Apr 2010 20:18:26 +0000
Subject: [PATCH] for backward compatibility we have the old parse function
 again. the old functionality is exposed by parse_

---
 src/compiler/GF/Command/Commands.hs     |  2 +-
 src/compiler/GF/Compile/ExampleBased.hs |  2 +-
 src/compiler/GF/Quiz.hs                 |  5 +----
 src/runtime/haskell/PGF.hs              | 30 ++++++++++++++++---------
 src/server/PGFService.hs                |  2 +-
 5 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index f89e497ad..2de7fb9cf 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -897,7 +897,7 @@ allCommands env@(pgf, mos) = Map.fromList [
   ]
  where
    par opts s = case optOpenTypes opts of
-                  []        -> [parse pgf lang (optType opts) s | lang <- optLangs opts]
+                  []        -> [parse_ pgf lang (optType opts) s | lang <- optLangs opts]
                   open_typs -> [parseWithRecovery pgf lang (optType opts) open_typs s | lang <- optLangs opts]
  
    void = ([],[])
diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs
index f197722ba..5c56c0ce5 100644
--- a/src/compiler/GF/Compile/ExampleBased.hs
+++ b/src/compiler/GF/Compile/ExampleBased.hs
@@ -41,7 +41,7 @@ convertFile conf src file = do
   convEx (cat,ex) = do
     appn "("
     let typ = maybe (error "no valid cat") id $ readType cat
-    ws <- case fst (parse pgf lang typ ex) of
+    ws <- case fst (parse_ pgf lang typ ex) of
       ParseFailed _ -> do
         let ws = morphoMissing morpho (words ex)
         appv ("WARNING: cannot parse example " ++ ex) 
diff --git a/src/compiler/GF/Quiz.hs b/src/compiler/GF/Quiz.hs
index 2a9b28ccb..0c48ea67d 100644
--- a/src/compiler/GF/Quiz.hs
+++ b/src/compiler/GF/Quiz.hs
@@ -46,10 +46,7 @@ translationList mex mprobs pgf ig og typ number = do
   return $ map mkOne $ ts
  where
    mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
-   homonyms t =
-     case (fst . parse pgf ig typ . linearize pgf ig) t of
-       ParseResult ts -> ts
-       _              -> []
+   homonyms = parse pgf ig typ . linearize pgf ig
 
 morphologyList :: 
   Maybe Expr -> Maybe Probabilities -> 
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index f2235cf37..26a727a47 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -58,7 +58,7 @@ module PGF(
            Forest.showBracketedString,
 
            -- ** Parsing
-           parse, parseWithRecovery, parseAllLang, parseAll,
+           parse, parseAllLang, parseAll, parse_, parseWithRecovery,
 
            -- ** Evaluation
            PGF.compute, paraphrase,
@@ -139,10 +139,7 @@ readPGF  :: FilePath -> IO PGF
 
 -- | Tries to parse the given string in the specified language
 -- and to produce abstract syntax expression.
-parse        :: PGF -> Language -> Type -> String -> (Parse.ParseResult,Maybe BracketedString)
-
--- | This is an experimental function. Use it on your own risk
-parseWithRecovery :: PGF -> Language -> Type -> [Type] -> String -> (Parse.ParseResult,Maybe BracketedString)
+parse        :: PGF -> Language -> Type -> String -> [Tree]
 
 -- | The same as 'parseAllLang' but does not return
 -- the language.
@@ -156,6 +153,12 @@ parseAll     :: PGF -> Type -> String -> [[Tree]]
 -- for which at least one parsing is possible are listed.
 parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]
 
+-- | The same as 'parse' but returns more detailed information
+parse_       :: PGF -> Language -> Type -> String -> (Parse.ParseResult,Maybe BracketedString)
+
+-- | This is an experimental function. Use it on your own risk
+parseWithRecovery :: PGF -> Language -> Type -> [Type] -> String -> (Parse.ParseResult,Maybe BracketedString)
+
 -- | The same as 'generateAllDepth' but does not limit
 -- the depth in the generation, and doesn't give an initial expression.
 generateAll      :: PGF -> Type -> [Expr]
@@ -217,7 +220,17 @@ complete :: PGF -> Language -> Type -> String
 
 readPGF f = decodeFile f
 
-parse pgf lang typ s = 
+parse pgf lang typ s =
+  case parse_ pgf lang typ s of
+    (Parse.ParseResult ts,_) -> ts
+    _                        -> []
+
+parseAll mgr typ = map snd . parseAllLang mgr typ
+
+parseAllLang mgr typ s = 
+  [(lang,ts) | lang <- languages mgr, (Parse.ParseResult ts,_) <- [parse_ mgr lang typ s]]
+
+parse_ pgf lang typ s = 
   case Map.lookup lang (concretes pgf) of
     Just cnc -> Parse.parse pgf lang typ (words s)
     Nothing  -> error ("Unknown language: " ++ showCId lang)
@@ -231,11 +244,6 @@ groupResults = Map.toList . foldr more Map.empty . start . concat
   more (l,s) = 
     Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s
 
-parseAll mgr typ = map snd . parseAllLang mgr typ
-
-parseAllLang mgr typ s = 
-  [(lang,ts) | lang <- languages mgr, (Parse.ParseResult ts,_) <- [parse mgr lang typ s], not (null ts)]
-
 generateRandom pgf cat = do
   gen <- newStdGen
   return $ genRandom gen pgf cat
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index f27380332..900e3f7cd 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -310,7 +310,7 @@ cat pgf mcat = fromMaybe (PGF.startCat pgf) mcat
 
 parse' :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> [(PGF.Language,[PGF.Tree])]
 parse' pgf input mcat mfrom = 
-   [(from,ts) | from <- froms, canParse pgf from, (PGF.ParseResult ts,_) <- [PGF.parse pgf from cat input]]
+   [(from,ts) | from <- froms, canParse pgf from, (PGF.ParseResult ts,_) <- [PGF.parse_ pgf from cat input]]
   where froms = maybe (PGF.languages pgf) (:[]) mfrom
         cat = fromMaybe (PGF.startCat pgf) mcat