content: module Main where
  
  -- to learn a lexicon from Google translate via sentence translation
  
  import System
  
  main = do
    xx <- getArgs
    case xx of
      "align":trees:lins:_ -> do
        ts <- readFile trees >>= return . lines
        ls <- readFile lins  >>= return . lines
        mapM_ (putStrLn . align) (zip ts ls)
      n:f:_ -> do
        nouns <- readFile n >>= return . words
        preds <- readFile f >>= return . words
        interact (const (mkExx nouns preds))
  
  type Ident = String
  
  mkExx nouns preds = unlines $ map predic (zip nouns predss) where
    predss = preds ++ predss -- there are more nouns than predicates
  
  predic :: (Ident,Ident) -> String
  predic (n,f) = case c of
    'A':_ -> predn n ("(UseComp (CompAP (PositA " ++ f ++ ")))")
    "V2" -> predn n ("(ComplSlash (SlashV2a " ++ f ++ ") (" ++ detn n ++ "))")
    'V':_ -> predn n ("(UseV " ++ f ++ ")")
   where
     c = tail $ dropWhile (/='_') f
  
  predn n f = "PredVP (" ++ detn n ++ ") " ++ f
  detn n = "DetCN (DetQuant DefArt NumSg) (UseN " ++ n ++ ")"
  
  align (t,s) = unlines [
    noun ++ " = mkN " ++ nargs ++ " ;",
    pred ++ " = mk" ++ cat ++ " " ++ fargs ++ " ;"
    ]
   where
    (noun,(pred,cat)) = case words t of
      _:_:_:_:_:_:n:ps -> (
        takeWhile (/=')') n, 
        case ps of 
          "(UseComp":_:_:a:_ -> (takeWhile (/=')') a,"A")
          "(UseV":v:_ -> (takeWhile (/=')') v,"V")
          "(ComplSlash":_:v:_ -> (takeWhile (/=')') v,"V2")
        )
    (nargs,fargs) = case words s of
      de:n:"is":a:_ -> (nargsOf n de, quote (init a))
      de:n:v:_:_  -> (nargsOf n de, quote (verb v))
      de:n:v:_    -> (nargsOf n de, quote (verb (init v)))
  
  nargsOf n d = unwords [quote n, if d == "Het" then "neuter" else "utrum"]
  
  verb s = init s ++ "en"
  
  quote s = "\"" ++ s ++ "\""
  
  
  
  -- do this way:
  
  {-
  gf LangEng
  > gt -cat=N | wf -file=ns
  > gt -cat=A | wf -file=fs
  > gt -cat=V | wf -append -file=fs
  > gt -cat=V2 | wf -append -file=fs
  
  sort -u ns >nouns
  sort -u fs >preds
  
  runghc MkExx.hs nouns preds >exx-input
  
  gf
  > rf -file=exx-input -lines -tree | l | wf -file=all-exx
  
  ghci
  > let mk (_:c:cs) = Data.Char.toUpper c : cs ++ "."
  > do {s <- readFile "all-exx" ; writeFile "trans-eng" (unlines (map mk (lines s)))}
  
  -- google-translate trans-eng, obtaining trans-dut
  
  -- align the files, producing LexiconDut.gf
  
  runghc MkExx.hs align exx-input trans-dut | sort -u >newlex
  
  -}
  
  