first incarnation of the bracketed string API

3 files changed, 43 insertions, 17 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 0273b82eb..f89e497ad 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -22,6 +22,7 @@ import PGF.Morphology
 import PGF.Printer
 import PGF.Probabilistic -- (getProbsFromFile,prProbabilities,defaultProbabilities)
 import PGF.Generate (generateRandomFrom) ----
+import PGF.Tree (Tree(Fun), expr2tree, tree2expr)
 import GF.Compile.Export
 import GF.Compile.ExampleBased
 import GF.Infra.Option (noOptions, readOutputFormat)
@@ -150,7 +151,7 @@ allCommands env@(pgf, mos) = Map.fromList [
        "flag -format."
        ],
      exec = \opts es -> do
-         let grph = if null es then [] else graphvizAlignment pgf (head es)
+         let grph = if null es then [] else graphvizAlignment pgf (languages pgf) (head es)
          if isFlag "view" opts || isFlag "format" opts then do
            let file s = "_grph." ++ s
            let view = optViewGraph opts
@@ -481,11 +482,14 @@ allCommands env@(pgf, mos) = Map.fromList [
        "will accept unknown adjectives, nouns and verbs with the resource grammar."
        ],
      exec = \opts ts -> 
-              returnFromExprsPar opts ts $ concatMap (par opts) $ toStrings ts,
+              return $ fromParse opts ts $ concatMap (par opts) $ toStrings ts,
      flags = [
        ("cat","target category of parsing"),
        ("lang","the languages of parsing (comma-separated, no spaces)"),
        ("openclass","list of open-class categories for robust parsing")
+       ],
+     options = [
+       ("bracket","prints the bracketed string from the parser")
        ]
      }),
   ("pg", emptyCommandInfo { -----
@@ -893,8 +897,8 @@ allCommands env@(pgf, mos) = Map.fromList [
   ]
  where
    par opts s = case optOpenTypes opts of
-                  []        -> concat  [parse pgf lang (optType opts) s | lang <- optLangs opts]
-                  open_typs -> concat  [parseWithRecovery pgf lang (optType opts) open_typs 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 = ([],[])
 
@@ -918,9 +922,17 @@ allCommands env@(pgf, mos) = Map.fromList [
                                    map (map (unl . snd)) . tabularLinearizes pgf lang
        _ | isOpt "table"   opts -> unlines . concat . intersperse [[]] . 
                     map (map (\(p,v) -> p+++":"+++unl v)) . tabularLinearizes pgf lang
-       _ | isOpt "bracket" opts -> unlines . markLinearizes pgf lang
+       _ | isOpt "bracket" opts -> showBracketedString . bracketedLinearize pgf lang
        _                        -> unl . linearize pgf lang
 
+   -- replace each non-atomic constructor with mkC, where C is the val cat
+   tree2mk pgf = showExpr [] . tree2expr . t2m . expr2tree where
+     t2m t = case t of
+       Fun cid [] -> t
+       Fun cid ts -> Fun (mk cid) (map t2m ts)
+       _ -> t
+     mk = mkCId . ("mk" ++) . showCId . lookValCat pgf
+
    unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ----
 
    getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
@@ -991,14 +1003,22 @@ allCommands env@(pgf, mos) = Map.fromList [
    toStrings = map showAsString 
    toString = unwords . toStrings
 
+   fromParse opts ts parses
+     | isOpt "bracket" opts = case catMaybes bss of
+                                []  -> ([], "no brackets found")
+                                bss -> ([], unlines $ map showBracketedString bss)
+     | otherwise            = case ts of
+                                [] -> ([], "no trees found" ++ 
+                                           missingWordMsg (optMorpho opts) (concatMap words (toStrings ts))
+                                      )
+                                _  -> fromExprs ts
+     where
+       (prs,bss) = unzip parses
+       ts        = [t | ParseResult ts <- prs, t <- ts]
+
    returnFromExprs es = return $ case es of
      [] -> ([], "no trees found")
      _  -> fromExprs es
-   returnFromExprsPar opts ts es = return $ case es of
-     [] -> ([], "no trees found" ++ 
-                missingWordMsg (optMorpho opts) (concatMap words (toStrings ts))
-            )
-     _  -> fromExprs es
 
    prGrammar opts
      | isOpt "cats"     opts = return $ fromString $ unwords $ map showCId $ categories pgf
diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs
index 983f38869..f197722ba 100644
--- a/src/compiler/GF/Compile/ExampleBased.hs
+++ b/src/compiler/GF/Compile/ExampleBased.hs
@@ -41,17 +41,20 @@ convertFile conf src file = do
   convEx (cat,ex) = do
     appn "("
     let typ = maybe (error "no valid cat") id $ readType cat
-    let ts = rank $ parse pgf lang typ ex
-    ws <- case ts of
-      []   -> do
+    ws <- case fst (parse pgf lang typ ex) of
+      ParseFailed _ -> do
         let ws = morphoMissing morpho (words ex)
         appv ("WARNING: cannot parse example " ++ ex) 
         case ws of
           [] -> return ()
           _  -> appv ("  missing words: " ++ unwords ws)
-        return ws 
-      t:tt -> appv ("WARNING: ambiguous example " ++ ex) >>
-              appn t >> mapM_ (appn . ("  --- " ++)) tt >> return []
+        return ws
+      TypeError _ _ ->
+        return []
+      ParseResult ts ->
+        case rank ts of
+          (t:tt) -> appv ("WARNING: ambiguous example " ++ ex) >>
+                    appn t >> mapM_ (appn . ("  --- " ++)) tt >> return []
     appn ")"
     return ws
   rank ts = case probs conf of
diff --git a/src/compiler/GF/Quiz.hs b/src/compiler/GF/Quiz.hs
index 4a4caafc8..2a9b28ccb 100644
--- a/src/compiler/GF/Quiz.hs
+++ b/src/compiler/GF/Quiz.hs
@@ -46,7 +46,10 @@ 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 = nub . parse pgf ig typ . linearize pgf ig
+   homonyms t =
+     case (fst . parse pgf ig typ . linearize pgf ig) t of
+       ParseResult ts -> ts
+       _              -> []
 
 morphologyList :: 
   Maybe Expr -> Maybe Probabilities ->