no more IO in the syntax to API translator

2 files changed, 54 insertions, 60 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index c82ee79af..c9f4b4945 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -854,7 +854,7 @@ allCommands env@(pgf, mos) = Map.fromList [
        then return $ fromString $ unlines $ map (tree2mk pgf) es  
        else if isOpt "api" opts
        then do 
-         ss <- mapM exprToAPIIO es
+         let ss = map exprToAPI es
          mapM_ putStrLn ss
          return void
        else do
diff --git a/src/runtime/haskell/PGF/ToApi.hs b/src/runtime/haskell/PGF/ToApi.hs
index e22132c34..c11aa7341 100644
--- a/src/runtime/haskell/PGF/ToApi.hs
+++ b/src/runtime/haskell/PGF/ToApi.hs
@@ -1,5 +1,5 @@
 module PGF.ToAPI 
- (stringToAPI,exprToAPI,exprToAPIIO)
+ (stringToAPI,exprToAPI)
   where
 
 import PGF.Expr
@@ -14,11 +14,6 @@ import qualified Data.Map as Map
 import PGF.Signature
 
 
---- this will be changed
-exprToAPIIO :: Expr -> IO String
-exprToAPIIO = exprToAPI   -- return . exprToAPI
-
-
 -- intermediate structure for representing the translated expression
 data APIfunc = BasicFunc String | AppFunc String [APIfunc] | NoAPI  
   deriving (Show,Eq)
@@ -28,38 +23,38 @@ data APIfunc = BasicFunc String | AppFunc String [APIfunc] | NoAPI
 
 -- translates a GF expression/tree into an equivalent one which uses functions from the GF
 -- API instead of the syntactic modules
-exprToAPI :: Expr -> IO String
+exprToAPI :: Expr -> String
 exprToAPI expr = 
-    do ffs <- exprToFunc expr 
-       return $ printAPIfunc ffs
+    let ffs = exprToFunc expr 
+       in printAPIfunc ffs
 
 
 
 
 -- translates a GF expression/tree written as a string to its correspondent which uses API functions
 -- the string is parsed into a GF expression/tree first
-stringToAPI :: String -> IO String
+stringToAPI :: String -> String
 stringToAPI expressionToRead = 
         case readExpr expressionToRead of
              Just ex -> exprToAPI ex                
-             _       -> fail "incorrect expression given as input "
+             _       -> error "incorrect expression given as input "
 
 
 
 
 -- function for translating an expression into APIFunc with type inference for  
 -- the type of the expression
-exprToFunc :: Expr -> IO APIfunc
+exprToFunc :: Expr -> APIfunc
 exprToFunc expr = 
    case unApp expr of
       Just (cid,l) -> 
          case Map.lookup (showCId cid) syntaxFuncs of 
             Just sig -> mkAPI True (fst sig,expr)
             _        -> case l of 
-                          [] -> return $ BasicFunc (showCId cid) 
-                          _  -> do es <- mapM exprToFunc l 
-                                   return $ AppFunc (showCId cid) es
-      _ -> return $ BasicFunc (showExpr [] expr)
+                          [] -> BasicFunc (showCId cid) 
+                          _  -> let es = map exprToFunc l 
+                                   in  AppFunc (showCId cid) es
+      _ -> BasicFunc (showExpr [] expr)
 
         
        
@@ -67,7 +62,7 @@ exprToFunc expr =
 
 -- main function for translating an expression along with its type into an APIFunc
 -- the boolean controls the need to optimize the result
-mkAPI :: Bool -> (String, Expr) -> IO APIfunc
+mkAPI :: Bool -> (String, Expr) -> APIfunc
 mkAPI opt (ty,expr) = 
  if elem ty rephraseable then rephraseSentence ty expr 
   else if opt then if elem ty optimizable then optimize expr else computeAPI (ty,expr)
@@ -76,17 +71,17 @@ mkAPI opt (ty,expr) =
      rephraseSentence ty expr = 
        case unApp expr of 
          Just (cid,es) -> if isPrefixOf "Use" (showCId cid) then 
-                                                            do let newCat = drop 3 (showCId cid)
-                                                               afClause <- mkAPI True (newCat, es !! 2)
-                                                               afPol <- mkAPI True ("Pol",es !! 1)                                         
-                                                               lTense <- mkAPI True ("Temp", head es)                                        
-                                                               case lTense of 
+                                                             let newCat = drop 3 (showCId cid)
+                                                                 afClause = mkAPI True (newCat, es !! 2)
+                                                                 afPol = mkAPI True ("Pol",es !! 1)                                         
+                                                                 lTense = mkAPI True ("Temp", head es)                                        
+                                                              in case lTense of 
                                                                   AppFunc _ [BasicFunc s1, BasicFunc s2] -> 
                                                                       let (r1,r2) = getTemporalParam s1 s2 in  
-                                                                        return $ AppFunc ("mk"++newCat) [r1,r2,afPol,afClause] 
-                                                                  _ -> fail $ "erroneous tense"          
+                                                                         AppFunc ("mk"++newCat) [r1,r2,afPol,afClause] 
+                                                                  _ ->  error "erroneous tense"          
                            else (mkAPI False) (ty,expr)
-         _             -> fail $ "incorrect for for expression "++ showExpr [] expr
+         _             -> error $ "incorrect for for expression "++ showExpr [] expr
      
      getTemporalParam s1 s2 = 
                          let r1 = case s1 of 
@@ -101,33 +96,32 @@ mkAPI opt (ty,expr) =
 
 
 
-computeAPI :: (String,Expr) -> IO APIfunc
+computeAPI :: (String,Expr) ->  APIfunc
 computeAPI (ty,expr) =
    case (unApp expr) of 
      Just (cid,[]) ->  getSimpCat (showCId cid) ty
      Just (cid,es) -> 
-         do p <- specFunction (showCId cid) es  
-            if isJust p then return $ fromJust p
+        let p = specFunction (showCId cid) es  
+          in if isJust p then fromJust p
               else case Map.lookup (show cid) syntaxFuncs of
                     Nothing -> exprToFunc expr    
                     Just (nameCat,typesExps) -> 
-       
                       if elem nameCat hiddenCats && length es == 1 then  (mkAPI True) (head typesExps,head es)
-                       else if elem nameCat hiddenCats then fail $ "incorrect coercion "++nameCat++" - "++show es   
-                              else do afs <- mapM (mkAPI True) (zip typesExps es)
-                                      return $ AppFunc ("mk" ++ nameCat) afs 
-     _         -> fail "error"          
+                       else if elem nameCat hiddenCats then error $ "incorrect coercion "++nameCat++" - "++show es   
+                              else let afs = map (mkAPI True) (zip typesExps es)
+                                      in AppFunc ("mk" ++ nameCat) afs 
+     _         -> error "error"          
   where 
-    getSimpCat "IdRP" _     = return $ BasicFunc "which_RP"
-    getSimpCat "DefArt" _   = return $ BasicFunc "the_Art"
-    getSimpCat "IndefArt" _ = return $ BasicFunc "a_Art"
-    getSimpCat "NumSg" _    = return $ NoAPI
-    getSimpCat "NumPl" _    = return $ BasicFunc "plNum"
-    getSimpCat "PPos" _     = return $ NoAPI
-    getSimpCat "PNeg" _     = return $ BasicFunc "negativePol"
+    getSimpCat "IdRP" _     = BasicFunc "which_RP"
+    getSimpCat "DefArt" _   = BasicFunc "the_Art"
+    getSimpCat "IndefArt" _ = BasicFunc "a_Art"
+    getSimpCat "NumSg" _    = NoAPI
+    getSimpCat "NumPl" _    = BasicFunc "plNum"
+    getSimpCat "PPos" _     = NoAPI
+    getSimpCat "PNeg" _     = BasicFunc "negativePol"
     getSimpCat cid ty       = if elem ty ["PConj","Voc"] && isInfixOf "No" cid
-                                 then return NoAPI 
-                                  else return $ BasicFunc cid
+                                 then NoAPI 
+                                  else BasicFunc cid
 
     specFunction "PassV2" es     = rephraseUnary "passiveVP" "V2" es
     specFunction "ReflA2" es     = rephraseUnary "reflAP" "A2" es
@@ -135,16 +129,16 @@ computeAPI (ty,expr) =
     specFunction "TFullStop" es  = rephraseText "fullStopPunct" es
     specFunction "TExclMark" es  = rephraseText "exclMarkPunct" es
     specFunction "TQuestMark" es = rephraseText "questMarkPunct" es
-    specFunction _ _             = return Nothing
+    specFunction _ _             = Nothing
 
     rephraseUnary ss ty es = 
-     do afs <- mkAPI True (ty,head es) 
-        return $ Just (AppFunc ss [afs])
+     let afs = mkAPI True (ty,head es) 
+        in Just (AppFunc ss [afs])
 
     rephraseText ss es = 
-     do afs <- mapM (mkAPI True) (zip ["Phr","Text"] es)
-        if afs !! 1 == BasicFunc "TEmpty" then return $ Just (AppFunc "mkText" [head afs,BasicFunc ss])
-           else return $ Just (AppFunc "mkText" [head afs, BasicFunc ss, last afs])
+     let afs = map (mkAPI True) (zip ["Phr","Text"] es) in
+        if afs !! 1 == BasicFunc "TEmpty" then  Just (AppFunc "mkText" [head afs,BasicFunc ss])
+           else Just (AppFunc "mkText" [head afs, BasicFunc ss, last afs])
 
 
 
@@ -154,26 +148,26 @@ optimize expr = optimizeNP expr
 optimizeNP expr = 
    case unApp expr of
      Just (cid,es) -> 
-         if showCId cid == "MassNP" then do afs <- nounAsCN (head es)
-                                            return $ AppFunc "mkNP" [afs]
-           else if showCId cid == "DetCN" then do quants <- quantAsDet (head es)
-                                                  ns     <- nounAsCN (head $ tail es)
-                                                  return $ AppFunc "mkNP" (quants ++ [ns])
+         if showCId cid == "MassNP" then let afs = nounAsCN (head es)
+                                           in AppFunc "mkNP" [afs]
+           else if showCId cid == "DetCN" then let quants = quantAsDet (head es)
+                                                   ns     = nounAsCN (head $ tail es)
+                                                  in AppFunc "mkNP" (quants ++ [ns])
                  else mkAPI False ("NP",expr)
-     _             -> fail $ "incorrect expression " ++ (showExpr [] expr)
+     _             -> error $ "incorrect expression " ++ (showExpr [] expr)
     where 
      nounAsCN expr = 
       case unApp expr of 
        Just (cid,es) -> if showCId cid == "UseN" then (mkAPI False) ("N",head es)
            else (mkAPI False) ("CN",expr)
-       _ -> fail $ "incorrect expression "++ (showExpr [] expr)
+       _ -> error $ "incorrect expression "++ (showExpr [] expr)
 
      quantAsDet expr =
        case unApp expr of
-        Just (cid,es) -> if showCId cid == "DetQuant" then mapM (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
-                           else do l <- (mkAPI False) ("Det",expr)
-                                   return [l]
-        _             -> fail $ "incorrect expression "++ (showExpr [] expr)
+        Just (cid,es) -> if showCId cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
+                           else [mkAPI False ("Det",expr)]
+                                  
+        _             -> error $ "incorrect expression "++ (showExpr [] expr)