module NLP.GenI.Morphology where

import Data.Maybe (isNothing, isJust)
import Data.List (intersperse)
import Data.Tree
import qualified Data.Map as Map
import System.IO
import System.Process

import NLP.GenI.Btypes
import NLP.GenI.General
import NLP.GenI.Tags

type MorphFn = Pred -> Maybe Flist

-- | Converts information from a morphological information file into GenI's
--   internal format.
readMorph :: [(String,[AvPair])] -> MorphFn
readMorph minfo pred_ = Map.lookup key fm
  where fm = Map.fromList minfo
        key = show $ snd3 pred_

-- | Filters away from an input semantics any literals whose realisation is
--   strictly morphological.  The first argument tells us helps identify the
--   morphological literals -- it associates literals with morphological stuff;
--   if it returns 'Nothing', then it is non-morphological
stripMorphSem :: MorphFn -> Sem -> Sem
stripMorphSem morphfn tsem = 
  [ l | l <- tsem, (isNothing.morphfn) l ]

-- | 'attachMorph' @morphfn sem cands@ does the bulk of the morphological
--   input processing.  We use @morphfn@ to determine which literals in
--   @sem@ contain morphological information and what information they contain.
--   Then we attach this morphological information to the relevant trees in
--   @cand@.  A tree is considered relevant w.r.t to a morphological
--   literal if its semantics contains at least one literal whose first index
--   is the same as the first index of the morphological literal.
attachMorph :: MorphFn -> Sem -> [TagElem] -> [TagElem]
attachMorph morphfn sem cands = 
  let -- relevance of a tree wrt to an index
      relTree i = not.null.relfilt.tsemantics
        where relfilt = filter (relLit i)  
      relLit i l = if null args then False else (head args == i)
        where args = thd3 l
      -- perform the attachment for a tree if it is relevant
      attachHelper :: GeniVal -> Flist -> TagElem -> TagElem  
      attachHelper i mfs t = 
        if relTree i t then attachMorphHelper mfs t else t 
      -- perform all attachments for a literal
      attach :: Pred -> [TagElem] -> [TagElem]
      attach l cs = 
        case morphfn l of 
          Nothing  -> cs
          Just mfs -> map (attachHelper i mfs) cs
        where i = if null args then GAnon else head args
              args = thd3 l 
  in foldr attach cands sem 

-- | Actually unify the morphological features into the anchor node
--
--   FIXME: we'll need to make sure this still works as promised 
--   when we implement co-anchors.
attachMorphHelper :: Flist -> TagElem -> TagElem
attachMorphHelper mfs te = 
  let -- unification with anchor
      tt     = ttree te 
      anchor = head $ filterTree fn tt
               where fn a = (ganchor a && gtype a == Lex)
  in case unifyFeat mfs (gup anchor) of
     Nothing -> error ("Morphological unification failure on " ++ idname te)
     Just (unf,subst) ->
      let -- perform replacements
          te2 = replace subst te 
          tt2 = ttree te2
          -- replace the anchor with the unification results
          newgdown = replace subst (gdown anchor) 
          newa = anchor { gup = unf, gdown = newgdown }
      in te2 { ttree = setMorphAnchor newa tt2 }

setMorphAnchor :: GNode -> Tree GNode -> Tree GNode
setMorphAnchor n t =
  let filt (Node a _) = (gtype a == Lex && ganchor a)
      fn (Node _ l)   = Node n l
  in (head.fst) $ listRepNode fn filt [t]

-- | Extracts the lemmas from a list of uninflected sentences.  This is used
--   when the morphological generator is unavailable, doesn't work, etc.
sansMorph :: [(String,Flist)] -> [String]
sansMorph = singleton . unwords . (map fst)

type MorphLexicon = [(String, String, Flist)]
type UninflectedDisjunction = (String, Flist)

-- | Return a list of results for each sentence
inflectSentencesUsingLex :: MorphLexicon -> [[UninflectedDisjunction]] -> [[String]]
inflectSentencesUsingLex mlex = map (inflectSentenceUsingLex mlex)

inflectSentenceUsingLex :: MorphLexicon -> [UninflectedDisjunction] -> [String]
inflectSentenceUsingLex mlex = map unwords . mapM (inflectWordUsingLex mlex)

-- | Return only n matches, but note any excessive ambiguities or missing matches
inflectWordUsingLex :: MorphLexicon -> UninflectedDisjunction -> [String]
inflectWordUsingLex mlex (lem,fs)
   | null matches       = [ lem ++ "-" ] -- no matches = lemma plus little icon
   | length matches > 2 = [ lem ++ "*" ] -- too many matches!
   | otherwise          = matches
  where
   matches = [ word | (word, mLem, mFs) <- mlex, lem == mLem, isJust $ fs `unifyFeat` mFs ]

-- | Converts a list of uninflected sentences into inflected ones by calling
---  the third party software.
-- FIXME: this doesn't actually support lists-of-results per input
-- will need to work it out
inflectSentencesUsingCmd :: String -> [[UninflectedDisjunction]] -> IO [[String]]
inflectSentencesUsingCmd morphcmd sentences =
  do -- add intersential delimiters
     let delim    = [("----",[])]
         morphlst = concat (intersperse delim sentences)
     -- format the stuff as input to the inflector
     let fn (lem,fs) = lem ++ " " ++ showFlist fs
         order = unlines $ map fn morphlst 
     -- run the inflector
     (toP, fromP, _, pid) <- runInteractiveCommand morphcmd
     hPutStrLn toP order
     hClose toP
     waitForProcess pid 
     -- read the inflector output back as a list of strings
     (map (singleton . trim) . lines) `fmap` hGetContents fromP
  `catch` \e -> do ePutStrLn "Error calling morphological generator"
                   ePutStrLn $ show e
                   return $ map sansMorph sentences

singleton :: a -> [a]
singleton x = [x]