export the morphology API from PGF

4 files changed, 29 insertions, 24 deletions

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index d915ac5bf..97685b7ce 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -730,16 +730,16 @@ allCommands cod env@(pgf, mos) = Map.fromList [
 
    prGrammar opts
      | isOpt "cats"     opts = return $ fromString $ unwords $ map (showType []) $ categories pgf
-     | isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . morpho) $ optLangs opts
+     | isOpt "fullform" opts = return $ fromString $ concatMap (morpho "" prFullFormLexicon) $ optLangs opts
      | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) | 
                                                                   la <- optLangs opts, let cs = missingLins pgf la]
      | otherwise             = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
                                   return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf
 
    morphos opts s = 
-     [lookupMorpho (morpho la) s | la <- optLangs opts]
+     [morpho [] (\mo -> lookupMorpho mo s) la | la <- optLangs opts]
 
-   morpho la = maybe Map.empty id $ Map.lookup la mos
+   morpho z f la = maybe z f $ Map.lookup la mos
 
    -- ps -f -g s returns g (f s)
    stringOps menv opts s = foldr (menvop . app) s (reverse opts) where
@@ -802,4 +802,10 @@ infinity = 256
 lookFlag :: PGF -> String -> String -> Maybe String
 lookFlag pgf lang flag = lookConcrFlag pgf (mkCId lang) (mkCId flag)
 
+prFullFormLexicon :: Morpho -> String
+prFullFormLexicon mo = 
+  unlines [w ++ " : " ++ prMorphoAnalysis ts | (w,ts) <- fullFormLexicon mo]
+
+prMorphoAnalysis :: [(Lemma,Analysis)] -> String
+prMorphoAnalysis lps = unlines [showCId l ++ " " ++ p | (l,p) <- lps]
 
diff --git a/src/PGF.hs b/src/PGF.hs
index 8510aafa5..1efabcc3c 100644
--- a/src/PGF.hs
+++ b/src/PGF.hs
@@ -77,7 +77,11 @@ module PGF(
            Incremental.initState, Incremental.nextState, Incremental.getCompletions, Incremental.extractTrees,
 
            -- ** Generation
-           generateRandom, generateAll, generateAllDepth
+           generateRandom, generateAll, generateAllDepth,
+           
+           -- ** Morphological Analysis
+           Lemma, Analysis, Morpho,
+           lookupMorpho, buildMorpho
           ) where
 
 import PGF.CId
@@ -87,6 +91,7 @@ import PGF.TypeCheck
 import PGF.Paraphrase
 import PGF.Macros
 import PGF.Expr (Tree)
+import PGF.Morphology
 import PGF.Data hiding (functions)
 import PGF.Binary
 import qualified PGF.Parsing.FCFG.Active as Active
diff --git a/src/PGF/Morphology.hs b/src/PGF/Morphology.hs
index 2eb793d73..9eee71a97 100644
--- a/src/PGF/Morphology.hs
+++ b/src/PGF/Morphology.hs
@@ -1,4 +1,6 @@
-module PGF.Morphology where
+module PGF.Morphology(Lemma,Analysis,Morpho,
+                      buildMorpho,
+                      lookupMorpho,fullFormLexicon) where
 
 import PGF.ShowLinearize (collectWords)
 import PGF.Data
@@ -9,24 +11,16 @@ import Data.List (intersperse)
 
 -- these 4 definitions depend on the datastructure used
 
-type Morpho = Map.Map String [(Lemma,Analysis)]
-
-lookupMorpho :: Morpho -> String -> [(Lemma,Analysis)]
-lookupMorpho mo s = maybe noAnalysis id $ Map.lookup s mo
-
-buildMorpho :: PGF -> CId -> Morpho
-buildMorpho pgf = Map.fromListWith (++) . collectWords pgf
-
-prFullFormLexicon :: Morpho -> String
-prFullFormLexicon mo = 
-  unlines [w ++ " : " ++ prMorphoAnalysis ts | (w,ts) <- Map.assocs mo]
+type Lemma = CId
+type Analysis = String
 
-prMorphoAnalysis :: [(Lemma,Analysis)] -> String
-prMorphoAnalysis lps = unlines [l ++ " " ++ p | (l,p) <- lps]
+newtype Morpho = Morpho (Map.Map String [(Lemma,Analysis)])
 
-type Lemma = String
-type Analysis = String
+buildMorpho :: PGF -> Language -> Morpho
+buildMorpho pgf lang = Morpho (Map.fromListWith (++) (collectWords pgf lang))
 
-noAnalysis :: [(Lemma,Analysis)]
-noAnalysis = []
+lookupMorpho :: Morpho -> String -> [(Lemma,Analysis)]
+lookupMorpho (Morpho mo) s = maybe [] id $ Map.lookup s mo
 
+fullFormLexicon :: Morpho -> [(String,[(Lemma,Analysis)])]
+fullFormLexicon (Morpho mo) = Map.toList mo
diff --git a/src/PGF/ShowLinearize.hs b/src/PGF/ShowLinearize.hs
index d739d38f5..dd3b997a6 100644
--- a/src/PGF/ShowLinearize.hs
+++ b/src/PGF/ShowLinearize.hs
@@ -97,7 +97,7 @@ markLinearize pgf lang = concat . take 1 . linearizesMark pgf lang
 
 
 -- for Morphology: word, lemma, tags
-collectWords :: PGF -> CId -> [(String, [(String,String)])]
+collectWords :: PGF -> Language -> [(String, [(CId,String)])]
 collectWords pgf lang = 
     concatMap collOne 
       [(f,c,0) | (f,(DTyp [] c _,_,_)) <- Map.toList $ funs $ abstract pgf] 
@@ -108,6 +108,6 @@ collectWords pgf lang =
       RR  rs -> concat [fromRec f v t | (_,t) <- rs] 
       RT  rs -> concat [fromRec f (p:v) t | (p,t) <- rs]
       RFV rs -> concatMap (fromRec f v) rs
-      RS  s  -> [(s,[(showCId f,unwords (reverse v))])]
+      RS  s  -> [(s,[(f,unwords (reverse v))])]
       RCon c -> [] ---- inherent